implementation module iTasks.Framework.SDSService

from Internet.HTTP					import :: HTTPRequest {req_method, req_path, req_data}, :: HTTPResponse(..), :: HTTPMethod(..)
from iTasks.Framework.IWorld		import :: IWorld {exposedShares}
from iTasks.Framework.Engine	    import :: ConnectionType

import iTasks.Framework.HtmlUtil, iTasks.Framework.DynamicUtil
import iTasks.Framework.RemoteAccess
from iTasks.Framework.SDS as SDS import qualified read, write, :: Shared
from iTasks.Framework.SDS import getURLbyId

from StdFunc import o
import StdString, StdList
from Data.Map import qualified get, fromList
from Data.Map import fromList
import Data.Maybe, Data.Void, Data.Error
import Text.URI
import StdMisc, StdDebug, graph_to_sapl_string

sdsService ::   (!(String -> Bool)
				 ,!Bool
                 ,!(HTTPRequest *IWorld -> *(!HTTPResponse, !Maybe ConnectionType, !*IWorld))
				 ,!(HTTPRequest (Maybe {#Char}) ConnectionType *IWorld -> (![{#Char}], !Bool, !ConnectionType, !*IWorld))
				 ,!(HTTPRequest ConnectionType *IWorld -> *IWorld)
				 )

sdsService = (matchFun,True,reqFun,dataFun,disconnectFun)
where
    matchFun :: String -> Bool
    matchFun reqUrl = case pathToSegments reqUrl of
    					["","sds",_] = True
    							  	 = False

	reqFun :: !HTTPRequest !*IWorld -> *(!HTTPResponse, !Maybe ConnectionType, !*IWorld)
	reqFun req iworld | hasParam "client_session_id" req
		= abort "Shareds on clients are not supported yet"
	reqFun req iworld=:{exposedShares} | hasParam "type" req
		# (sdsurl, iworld) = getURLbyId ((hd o tl o tl) (pathToSegments req.req_path)) iworld
		= case 'Data.Map'.get sdsurl exposedShares of
			Nothing = (notFoundResponse req,Nothing,iworld) 
			(Just (dyn, _)) = (jsonResponse (toString (unpackType dyn)), Nothing, iworld)
	reqFun req iworld=:{exposedShares}
		# (sdsurl, iworld) = getURLbyId ((hd o tl o tl) (pathToSegments req.req_path)) iworld
		= case 'Data.Map'.get sdsurl exposedShares of
			Nothing = (notFoundResponse req,Nothing,iworld) 
			(Just (_, shared)) = case req.req_method of
									HTTP_GET = readit shared iworld
									HTTP_PUT = writeit shared iworld
											 = (badRequestResponse "Invalid method",Nothing,iworld)
	where
		readit shared iworld
			# (res, iworld) = 'SDS'.read shared iworld
			= case res of
				(Ok json) = (jsonResponse json, Nothing, iworld)
				(Error e) = (errorResponse e, Nothing, iworld)			
			
		writeit shared iworld
			# (res, iworld) = 'SDS'.write (fromString req.req_data) shared iworld
			= case res of
				(Ok _)    = (jsonResponse "OK", Nothing, iworld)
				(Error e) = (errorResponse e, Nothing, iworld)			
			
	jsonResponse json
		= {okResponse & rsp_headers = [("Content-Type","text/json")], rsp_data = toString json}			
				
	dataFun :: !HTTPRequest !(Maybe {#Char}) !ConnectionType !*IWorld -> (![{#Char}], !Bool, !ConnectionType, !*IWorld)
    dataFun req mbData instanceNo iworld = ([], True, instanceNo, iworld)

    disconnectFun :: !HTTPRequest !ConnectionType !*IWorld -> *IWorld
	disconnectFun _ _ iworld = iworld
	
readRemoteSDS  :: !String !*IWorld -> *(!MaybeErrorString JSONNode, !*IWorld)
readRemoteSDS url iworld 
	= case convertURL url of
		(Ok url) 	= load url iworld
		(Error e) 	= (Error e, iworld)
where
	load url iworld
		# (response, iworld) = httpRequest HTTP_GET url Nothing iworld
		= if (isOkResponse response)
				(Ok (fromString response.rsp_data), iworld)
				(Error ("Request failed: "+++response.rsp_reason), iworld)

convertURL url
	= case parseURI url of
		Nothing 	= Error ("Malformed URL: "+++url)
		(Just uri) 	= if (maybe False ((<>) "sds") uri.uriScheme) 
							(Error ("Invalid URL: "+++url))
							(Ok (toString (convert uri)))
where
	convert u = {nullURI & uriScheme	= Just "http", 
						   uriRegName	= u.uriRegName, 
						   uriPort		= u.uriPort,
						   uriPath		= "/sds" +++ u.uriPath}
							
writeRemoteSDS :: !JSONNode !String !*IWorld -> *(!MaybeErrorString Void, !*IWorld)
writeRemoteSDS val url iworld 
	= case convertURL url of
		(Ok url) 	= load url val iworld
		(Error e) 	= (Error e, iworld)
where
	load url val iworld
		# (response, iworld) = httpRequest HTTP_PUT url (Just (toString (toJSON val))) iworld
		= if (isOkResponse response)
				(Ok Void, iworld)
				(Error ("Request failed: "+++response.rsp_reason), iworld)