{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, ScopedTypeVariables #-}-- | It should be noted that most of the code snippets below depend on the-- OverloadedStrings language pragma.moduleWeb.Scotty(-- * scotty-to-WAIscotty,scottyApp-- * Defining Middleware and Routes---- | 'Middleware' and routes are run in the order in which they-- are defined. All middleware is run first, followed by the first-- route that matches. If no route matches, a 404 response is given.,middleware,get,post,put,delete,addroute-- * Defining Actions-- ** Accessing the Request, Captures, and Query Parameters,request,param,jsonData-- ** Modifying the Response and Redirecting,status,header,redirect-- ** Setting Response Body---- | Note: only one of these should be present in any given route-- definition, as they completely replace the current 'Response' body.,text,html,file,json-- ** Exceptions,raise,rescue,next-- * Types,ScottyM,ActionM,Parsable)whereimportBlaze.ByteString.Builder(fromByteString,fromLazyByteString)importControl.ApplicativeimportControl.Monad.ErrorimportControl.Monad.ReaderimportqualifiedControl.Monad.StateasMSimportControl.Monad.Trans.Resource(ResourceT)importqualifiedData.AesonasAimportqualifiedData.ByteString.Char8asBimportqualifiedData.ByteString.Lazy.Char8asBLimportqualifiedData.CaseInsensitiveasCIimportData.Default(Default,def)importData.Conduit.Lazy(lazyConsume)importData.Maybe(fromMaybe)importData.Monoid(mconcat)importqualifiedData.Text.LazyasTimportData.Text.Lazy.Encoding(encodeUtf8)importNetwork.HTTP.TypesimportNetwork.WaiimportNetwork.Wai.Handler.Warp(Port,run)importWeb.Scotty.UtildataScottyState=ScottyState{middlewares::[Middleware],routes::[Middleware]}instanceDefaultScottyStatewheredef=ScottyState[][]newtypeScottyMa=S{runS::MS.StateTScottyStateIOa}deriving(Monad,MonadIO,Functor,MS.MonadStateScottyState)-- | Run a scotty application using the warp server.scotty::Port->ScottyM()->IO()scottyps=putStrLn"Setting phasers to stun... (ctrl-c to quit)">>(runp=<<scottyApps)-- | Turn a scotty application into a WAI 'Application', which can be-- run with any WAI handler.scottyApp::ScottyM()->IOApplicationscottyAppdefs=dos<-MS.execStateT(runSdefs)defreturn$foldl(flip($))notFoundApp$routess++middlewaressnotFoundApp::ApplicationnotFoundApp_=return$ResponseBuilderstatus404[("Content-Type","text/html")]$fromByteString"<h1>404: File Not Found!</h1>"-- | Use given middleware. Middleware is nested such that the first declared-- is the outermost middleware (it has first dibs on the request and last action-- on the response). Every middleware is run on each request.middleware::Middleware->ScottyM()middlewarem=MS.modify(\(ScottyStatemsrs)->ScottyState(m:ms)rs)typeParam=(T.Text,T.Text)dataActionError=RedirectT.Text|ActionErrorT.Text|Nextderiving(Eq,Show)instanceErrorActionErrorwherestrMsg=ActionError.T.packdataActionEnv=Env{getReq::Request,getParams::[Param],getBody::BL.ByteString}newtypeActionMa=AM{runAM::ErrorTActionError(ReaderTActionEnv(MS.StateTResponseIO))a}deriving(Monad,MonadIO,Functor,MonadReaderActionEnv,MS.MonadStateResponse,MonadErrorActionError)-- Nothing indicates route failed (due to Next) and pattern matching should continue.-- Just indicates a successful response.runAction::ActionEnv->ActionM()->IO(MaybeResponse)runActionenvaction=do(e,r)<-flipMS.runStateTdef$fliprunReaderTenv$runErrorT$runAM$action`catchError`defaultHandlerreturn$either(constNothing)(const$Justr)edefaultHandler::ActionError->ActionM()defaultHandler(Redirecturl)=dostatusstatus302header"Location"urldefaultHandler(ActionErrormsg)=dostatusstatus500html$mconcat["<h1>500 Internal Server Error</h1>",msg]defaultHandlerNext=next-- | Throw an exception, which can be caught with 'rescue'. Uncaught exceptions-- turn into HTTP 500 responses.raise::T.Text->ActionMaraise=throwError.ActionError-- | Abort execution of this action and continue pattern matching routes.-- Like an exception, any code after 'next' is not executed.---- As an example, these two routes overlap. The only way the second one will-- ever run is if the first one calls 'next'.---- > get "/foo/:number" $ do-- > n <- param "number"-- > unless (all isDigit n) $ next-- > text "a number"-- >-- > get "/foo/:bar" $ do-- > bar <- param "bar"-- > text "not a number"next::ActionManext=throwErrorNext-- | Catch an exception thrown by 'raise'.---- > raise "just kidding" `rescue` (\msg -> text msg)rescue::ActionMa->(T.Text->ActionMa)->ActionMarescueactionhandler=catchErroraction$\e->caseeofActionErrormsg->handlermsg-- handle errorsother->throwErrorother-- rethrow redirects and nexts-- | Redirect to given URL. Like throwing an uncatchable exception. Any code after the call to redirect-- will not be run.---- > redirect "http://www.google.com"---- OR---- > redirect "/foo/bar"redirect::T.Text->ActionM()redirect=throwError.Redirect-- | Get the 'Request' object.request::ActionMRequestrequest=getReq<$>ask-- | Parse the request body as a JSON object and return it. Raises an exception if parse is unsuccessful.jsonData::(A.FromJSONa)=>ActionMajsonData=dobody<-getBody<$>askmaybe(raise"jsonData: no parse")return$A.decodebody-- | Get a parameter. First looks in captures, then form data, then query parameters.---- * Raises an exception which can be caught by 'rescue' if parameter is not found.---- * If parameter is found, but 'read' fails to parse to the correct type, 'next' is called.-- This means captures are somewhat typed, in that a route won't match if a correctly typed-- capture cannot be parsed.param::(Parsablea)=>T.Text->ActionMaparamk=doval<-lookupk<$>getParams<$>askcasevalofNothing->raise$mconcat["Param: ",k," not found!"]Justv->either(constnext)return$parseParamvclassParsableawhereparseParam::T.Text->EitherT.Texta-- if any individual element fails to parse, the whole list fails to parse.parseParamList::T.Text->EitherT.Text[a]parseParamListt=sequence$mapparseParam(T.split(==',')t)-- No point using 'read' for Text, ByteString, Char, and String.instanceParsableT.TextwhereparseParam=RightinstanceParsableB.ByteStringwhereparseParam=Right.lazyTextToStrictByteStringinstanceParsableCharwhereparseParamt=caseT.unpacktof[c]->Rightc_->Left"parseParam Char: no parse"parseParamList=Right.T.unpack-- StringinstanceParsable()whereparseParamt=ifT.nulltthenRight()elseLeft"parseParam Unit: no parse"instance(Parsablea)=>Parsable[a]whereparseParam=parseParamListinstanceParsableBoolwhereparseParam=readEitherinstanceParsableDoublewhereparseParam=readEitherinstanceParsableFloatwhereparseParam=readEitherinstanceParsableIntwhereparseParam=readEitherinstanceParsableIntegerwhereparseParam=readEitherreadEither::(Reada)=>T.Text->EitherT.TextareadEithert=case[x|(x,"")<-reads(T.unpackt)]of[x]->Rightx[]->Left"readEither: no parse"_->Left"readEither: ambiguous parse"-- | get = addroute 'GET'get::T.Text->ActionM()->ScottyM()get=addrouteGET-- | post = addroute 'POST'post::T.Text->ActionM()->ScottyM()post=addroutePOST-- | put = addroute 'PUT'put::T.Text->ActionM()->ScottyM()put=addroutePUT-- | delete = addroute 'DELETE'delete::T.Text->ActionM()->ScottyM()delete=addrouteDELETE-- | Define a route with a 'StdMethod', 'T.Text' value representing the path spec,-- and a body ('ActionM') which modifies the response.---- > addroute GET "/" $ text "beam me up!"---- The path spec can include values starting with a colon, which are interpreted-- as /captures/. These are named wildcards that can be looked up with 'param'.---- > addroute GET "/foo/:bar" $ do-- > v <- param "bar"-- > text v---- >>> curl http://localhost:3000/foo/something-- somethingaddroute::StdMethod->T.Text->ActionM()->ScottyM()addroutemethodpathaction=MS.modify(\(ScottyStatemsrs)->ScottyStatems(r:rs))wherer=routemethodwithSlashactionwithSlash=caseT.unconspathofJust('/',_)->path_->T.cons'/'pathroute::StdMethod->T.Text->ActionM()->Middlewareroutemethodpathactionappreq=ifRightmethod==parseMethod(requestMethodreq)thencasematchRoutepath(strictByteStringToLazyText$rawPathInforeq)ofJustcaptures->doenv<-mkEnvmethodreqcapturesres<-lift$runActionenvactionmaybetryNextreturnresNothing->tryNextelsetryNextwheretryNext=appreqmkEnv::StdMethod->Request->[Param]->ResourceTIOActionEnvmkEnvmethodreqcaptures=dobody<-BL.fromChunks<$>(lazyConsume$requestBodyreq)letparams=captures++formparams++queryparamsformparams=case(method,lookup"Content-Type"[(CI.mkk,CI.mkv)|(k,v)<-requestHeadersreq])of(POST,Just"application/x-www-form-urlencoded")->parseEncodedParams$mconcat$BL.toChunksbody_->[]queryparams=parseEncodedParams$rawQueryStringreqreturn$EnvreqparamsbodyparseEncodedParams::B.ByteString->[Param]parseEncodedParamsbs=[(T.fromStrictk,T.fromStrict$fromMaybe""v)|(k,v)<-parseQueryTextbs]-- todo: wildcards?matchRoute::T.Text->T.Text->Maybe[Param]matchRoutepatreq=go(T.split(=='/')pat)(T.split(=='/')req)[]wherego[][]ps=Justps-- request string and pattern match!go[]rps|T.null(mconcatr)=Justps-- in case request has trailing slashes|otherwise=Nothing-- request string is longer than patterngop[]ps|T.null(mconcatp)=Justps-- in case pattern has trailing slashes|otherwise=Nothing-- request string is not long enoughgo(p:ps)(r:rs)prs|p==r=gopsrsprs-- equal literals, keeping checking|T.nullp=Nothing-- p is null, but r is not, fail|T.headp==':'=gopsrs$(T.tailp,r):prs-- p is a capture, add to params|otherwise=Nothing-- both literals, but unequal, fail-- | Set the HTTP response status. Default is 200.status::Status->ActionM()status=MS.modify.setStatus-- | Set one of the response headers. Will override any previously set value for that header.-- Header names are case-insensitive.header::T.Text->T.Text->ActionM()headerkv=MS.modify$setHeader(CI.mk$lazyTextToStrictByteStringk,lazyTextToStrictByteStringv)-- | Set the body of the response to the given 'T.Text' value. Also sets \"Content-Type\"-- header to \"text/plain\".text::T.Text->ActionM()textt=doheader"Content-Type""text/plain"MS.modify$setContent$Left$fromLazyByteString$encodeUtf8t-- | Set the body of the response to the given 'T.Text' value. Also sets \"Content-Type\"-- header to \"text/html\".html::T.Text->ActionM()htmlt=doheader"Content-Type""text/html"MS.modify$setContent$Left$fromLazyByteString$encodeUtf8t-- | Send a file as the response. Doesn't set the \"Content-Type\" header, so you probably-- want to do that on your own with 'header'.file::FilePath->ActionM()file=MS.modify.setContent.Right-- | Set the body of the response to the JSON encoding of the given value. Also sets \"Content-Type\"-- header to \"application/json\".json::(A.ToJSONa)=>a->ActionM()jsonv=doheader"Content-Type""application/json"MS.modify$setContent$Left$fromLazyByteString$A.encodev