{-# LANGUAGE RecordWildCards #-}{-# LANGUAGE OverloadedStrings #-}{-# LANGUAGE ScopedTypeVariables #-}{-# LANGUAGE NoImplicitPrelude #-}{-# LANGUAGE TemplateHaskell #-}moduleKeter.PortManager(-- * TypesPort,Host,PortManager,PortEntry(..)-- ** Settings,Settings,portRange-- * Actions,getPort,releasePort,addEntry,removeEntry,lookupPort-- * Initialize,start)whereimportKeter.PreludeimportqualifiedControl.Monad.Trans.StateasSimportControl.Monad.Trans.Class(lift)importqualifiedData.MapasMapimportControl.Monad(forever,mzero,mplus)importData.ByteString.Char8()importqualifiedNetworkimportqualifiedData.ByteStringasSimportData.Text.Encoding(encodeUtf8)importData.Yaml(FromJSON(parseJSON),Value(Object))importControl.Applicative((<$>))importqualifiedKeter.ReverseProxyasReverseProxy(RPEntry)-- | A port for an individual app to listen on.typePort=Int-- | A virtual host we want to serve content from.typeHost=StringdataCommand=GetPort(EitherSomeExceptionPort->KIO())|ReleasePortPort|AddEntryHostPortEntry|RemoveEntryHost|AddDefaultEntryPortEntry|RemoveDefaultEntry|LookupPortS.ByteString(MaybePortEntry->KIO())-- | An abstract type which can accept commands and sends them to a background-- nginx thread.newtypePortManager=PortManager(Command->KIO())-- | Controls execution of the nginx thread. Follows the settings type pattern.-- See: <http://www.yesodweb.com/book/settings-types>.dataSettings=Settings{portRange::[Port]-- ^ Which ports to assign to apps. Default: 4000-4999}instanceDefaultSettingswheredef=Settings{portRange=[4000..4999]}instanceFromJSONSettingswhereparseJSON(Object_)=Settings<$>return(portRangedef)parseJSON_=mzero-- | Start running a separate thread which will accept commands and modify-- Nginx's behavior accordingly.start::Settings->KIO(EitherSomeExceptionPortManager)startSettings{..}=dochan<-newChanforkKIO$flipS.evalStateTfreshState$forever$docommand<-lift$readChanchancasecommandofGetPortf->dons0<-S.getletloop::NState->KIO(EitherSomeExceptionPort,NState)loopns=casensAvailnsofp:ps->dores<-liftIO$Network.listenOn$Network.PortNumber$fromIntegralpcaseresofLeft(_::SomeException)->dolog$RemovingPortploopns{nsAvail=ps}Rightsocket->dores'<-liftIO$Network.sClosesocketcaseres'ofLefte->do$logExelog$RemovingPortploopns{nsAvail=ps}Right()->return(Rightp,ns{nsAvail=ps})[]->casereverse$nsRecyclednsof[]->return(Left$toExceptionNoPortsAvailable,ns)ps->loopns{nsAvail=ps,nsRecycled=[]}(eport,ns)<-lift$loopns0S.putnslift$feportReleasePortp->S.modify$\ns->ns{nsRecycled=p:nsRecycledns}AddEntryhe->change$Map.insert(encodeUtf8h)eRemoveEntryh->change$Map.delete$encodeUtf8hAddDefaultEntrye->S.modify$\ns->ns{nsDefault=Juste}RemoveDefaultEntry->S.modify$\ns->ns{nsDefault=Nothing}LookupPorthf->doNState{..}<-S.getlift$f$mplus(Map.lookuphnsEntries)nsDefaultreturn$Right$PortManager$writeChanchanwherechangef=dons<-S.getletentries=f$nsEntriesnsS.put$ns{nsEntries=entries}freshState=NStateportRange[]Map.emptyNothingdataNState=NState{nsAvail::[Port],nsRecycled::[Port],nsEntries::Map.MapS.ByteStringPortEntry,nsDefault::MaybePortEntry}-- | Gets an unassigned port number.getPort::PortManager->KIO(EitherSomeExceptionPort)getPort(PortManagerf)=dox<-newEmptyMVarf$GetPort$\p->putMVarxptakeMVarx-- | Inform the nginx thread that the given port number is no longer being-- used, and may be reused by a new process. Note that recycling puts the new-- ports at the end of the queue (FIFO), so that if an application holds onto-- the port longer than expected, there should be no issues.releasePort::PortManager->Port->KIO()releasePort(PortManagerf)p=f$ReleasePortp-- | Add a new entry to the configuration for the given hostname and reload-- nginx. Will overwrite any existing configuration for the given host. The-- second point is important: it is how we achieve zero downtime transitions-- between an old and new version of an app.addEntry::PortManager->Host->PortEntry->KIO()addEntry(PortManagerf)hp=f$casehof"*"->AddDefaultEntryp_->AddEntryhpdataPortEntry=PEPortPort|PEStaticFilePath|PERedirectS.ByteString|PEReverseProxyReverseProxy.RPEntry-- | Remove an entry from the configuration and reload nginx.removeEntry::PortManager->Host->KIO()removeEntry(PortManagerf)h=f$casehof"*"->RemoveDefaultEntry_->RemoveEntryhlookupPort::PortManager->S.ByteString->KIO(MaybePortEntry)lookupPort(PortManagerf)h=dox<-newEmptyMVarf$LookupPorth$\p->putMVarxptakeMVarx