-- | Exception handling and resource management integrated with proxies{-# LANGUAGE Rank2Types, CPP, KindSignatures #-}moduleControl.Proxy.Safe.Core(-- * Exception Handling-- $exceptionpmoduleControl.Proxy.Trans.Either,moduleControl.Exception,ExceptionP,throw,catch,handle,-- * Safe IOSafeIO,runSafeIO,runSaferIO,trySafeIO,trySaferIO,-- * Checked Exceptions-- $checkCheckP(..),tryK,tryIO,-- * FinalizationonAbort,finally,bracket,bracket_,bracketOnAbort,-- * Prompt Finalization-- $promptunsafeCloseU,unsafeCloseD,unsafeClose)whereimportqualifiedControl.ExceptionasEximportControl.Exception(SomeException,Exception)importControl.Applicative(Applicative(pure,(<*>)))importControl.Monad.Trans.Class(lift)importControl.Monad.Trans.Reader(ReaderT(ReaderT,runReaderT),asks)importqualifiedControl.ProxyasPimportqualifiedControl.Proxy.Core.FastasPFimportqualifiedControl.Proxy.Core.CorrectasPCimportControl.Proxy((->>),(>>~))importControl.Proxy.Trans.Maybe(MaybeP(runMaybeP))importqualifiedControl.Proxy.Trans.EitherasEimportqualifiedControl.Proxy.Trans.ReaderasRimportControl.Proxy.Trans.Eitherhiding(throw,catch,handle)importData.IORef(IORef,newIORef,readIORef,writeIORef)#if MIN_VERSION_base(4,6,0)#elseimportPreludehiding(catch)#endifimportSystem.IO.Error(userError){- $exceptionp
This library checks and stores all exceptions using the 'EitherP' proxy
transformer. The 'ExceptionP' type synonym simplifies type signatures.
Use 'runEitherP' / 'runEitherK' from the re-exported
@Control.Proxy.Trans.Either@ to convert 'ExceptionP' back to the base
monad
This module does not re-export 'E.throw', 'E.catch', and 'E.handle' from
@Control.Proxy.Trans.Either@ and instead defines new versions similar to the
API from @Control.Exception@. If you want the old versions you will need to
import them qualified.
This module only re-exports 'SomeException' and 'Exception' from
@Control.Exception@.
-}-- | A proxy transformer that stores exceptions using 'EitherP'typeExceptionP=EitherPSomeException-- | Analogous to 'Ex.throwIO' from @Control.Exception@throw::(Monadm,P.Proxyp,Ex.Exceptione)=>e->ExceptionPpa'ab'bmrthrow=E.throw.Ex.toException-- | Analogous to 'Ex.catch' from @Control.Exception@catch::(Ex.Exceptione,Monadm,P.Proxyp)=>ExceptionPpa'ab'bmr-- ^ Original computation->(e->ExceptionPpa'ab'bmr)-- ^ Handler->ExceptionPpa'ab'bmrcatchpf=p`E.catch`(\someExc->caseEx.fromExceptionsomeExcofNothing->E.throwsomeExcJuste->fe)-- | Analogous to 'Ex.handle' from @Control.Exception@handle::(Ex.Exceptione,Monadm,P.Proxyp)=>(e->ExceptionPpa'ab'bmr)-- ^ Handler->ExceptionPpa'ab'bmr-- ^ Original computation->ExceptionPpa'ab'bmrhandle=flipcatchdataStatus=Status{restore::foralla.IOa->IOa,upstream::IORef(IO()),downstream::IORef(IO())}{-| 'SafeIO' masks asynchronous exceptions by default, and only unmasks them
during 'try' or 'tryIO' blocks in order to check all asynchronous
exceptions.
'SafeIO' also saves all finalizers dropped as a result of premature
termination and runs them when the 'P.Session' completes.
-}newtypeSafeIOr=SafeIO{unSafeIO::ReaderTStatusIOr}instanceFunctorSafeIOwherefmapfm=SafeIO(fmapf(unSafeIOm))instanceApplicativeSafeIOwherepurer=SafeIO(purer)f<*>x=SafeIO(unSafeIOf<*>unSafeIOx)instanceMonadSafeIOwherereturnr=SafeIO(returnr)m>>=f=SafeIO(unSafeIOm>>=\a->unSafeIO(fa)){-| Convert back to the 'IO' monad, running all dropped finalizers at the very
end and rethrowing any checked exceptions
This uses 'Ex.mask' to mask asynchronous exceptions and only unmasks them
during 'try' or 'tryIO'.
-}runSafeIO::SafeIO(EitherSomeExceptionr)->IOrrunSafeIOm=Ex.mask$\restore->dohuRef<-newIORef(return())hdRef<-newIORef(return())e<-runReaderT(unSafeIOm)(StatusrestorehuRefhdRef)`Ex.finally`(dohu<-readIORefhuRefhuhd<-readIORefhdRefhd)caseeofLeftexc->Ex.throwIOexcRightr->returnr{-| Convert back to the 'IO' monad, running all dropped finalizers at the very
end and rethrowing any checked exceptions
This uses 'Ex.uninterruptibleMask' to mask asynchronous exceptions and only
unmasks them during 'try' or 'tryIO'.
-}runSaferIO::SafeIO(EitherSomeExceptionr)->IOrrunSaferIOm=Ex.uninterruptibleMask$\restore->dohuRef<-newIORef(return())hdRef<-newIORef(return())e<-runReaderT(unSafeIOm)(StatusrestorehuRefhdRef)`Ex.finally`(dohu<-readIORefhuRefhuhd<-readIORefhdRefhd)caseeofLeftexc->Ex.throwIOexcRightr->returnr{-| Convert back to the 'IO' monad, running all dropped finalizers at the very
end and preserving exceptions as 'Left's
This uses 'Ex.mask' to mask asynchronous exceptions and only unmasks them
during 'try' or 'tryIO'.
-}trySafeIO::SafeIOe->IOetrySafeIOm=Ex.mask$\restore->dohuRef<-newIORef(return())hdRef<-newIORef(return())runReaderT(unSafeIOm)(StatusrestorehuRefhdRef)`Ex.finally`(dohu<-readIORefhuRefhuhd<-readIORefhdRefhd){-| Convert back to the 'IO' monad, running all dropped finalizers at the very
end and preserving exceptions as 'Left's
This uses 'Ex.uninterruptibleMask' to mask asynchronous exceptions and only
unmasks them during 'try' or 'tryIO'.
-}trySaferIO::SafeIOe->IOetrySaferIOm=Ex.uninterruptibleMask$\restore->dohuRef<-newIORef(return())hdRef<-newIORef(return())runReaderT(unSafeIOm)(StatusrestorehuRefhdRef)`Ex.finally`(dohu<-readIORefhuRefhuhd<-readIORefhdRefhd){- I don't export 'register' only because people rarely want to guard solely
against premature termination. Usually they also want to guard against
exceptions, too.
@registerK = (register .)@ should satisfy the following laws:
* 'registerK' defines a functor from finalizers to functions:
> registerK morph m1 . registerK morph m2 = registerK morph (m2 >> m1)
>
> registerK morph (return ()) = id
* 'registerK' is a functor between Kleisli categories:
> registerK morph m (p1 >=> p2) = registerK morph m p1 >=> registerK morph m p2
>
> registerK morph m return = return
These laws are not provable using the current set of proxy laws, mainly
because the proxy laws do not yet specify how proxies interact with the
'Arrow' instance for the Kleisli category. However, I'm reasonably sure
that when I do specify this interaction that the above laws will hold.
For now, just consider the above laws the contract for 'register' and
consider any violations of the above laws as bugs.
-}register::(Monadm,P.Proxyp)=>(forallx.SafeIOx->mx)->IO()->pa'ab'bmr->pa'ab'bmrregistermorphhk=(P.runIdentityK(P.hoistKmorphup)->>k)>>~P.runIdentityK(P.hoistKmorphdn)wherednb0=dohuRef<-lift$SafeIO$asksdownstreamletdn'b=dohu<-lift$SafeIO$lift$dohu<-readIORefhuRefwriteIORefhuRef(hu>>h)returnhub'<-P.respondblift$SafeIO$lift$writeIORefhuRefhub2<-P.requestb'dn'b2dn'b0upa'0=dohdRef<-lift$SafeIO$asksupstreamletup'a'=dohd<-lift$SafeIO$lift$dohd<-readIORefhdRefwriteIORefhdRef(hd>>h)returnhda<-P.requesta'lift$SafeIO$lift$writeIORefhdRefhda'2<-P.respondaup'a'2up'a'0{- $check
The following @try@ functions are the only way to convert 'IO' actions to
'SafeIO'. These functions check all exceptions, including asynchronous
exceptions, and store them in the 'ExceptionP' proxy transformer.
-}{-| Use 'try' to retroactively check all exceptions for proxies that implement
'CheckP'.
'try' is /almost/ a proxy morphism (See @Control.Proxy.Morph@ from @pipes@
for the full list of laws). The only exception is the following law:
> try (return x) = return x
The left-hand side unmasks asynchronous exceptions and checks them
immediately, whereas the right-hand side delays asynchronous exceptions
until the next 'try' or 'tryIO' block.
-}class(P.Proxyp)=>CheckPpwheretry::pa'ab'bIOr->ExceptionPpa'ab'bSafeIOrinstanceCheckPPF.ProxyFastwheretryp0=EitherP(gop0)wheregop=casepofPF.Requesta'fa->PF.Requesta'(\a->go(faa))PF.Respondbfb'->PF.Respondb(\b'->go(fb'b'))PF.Mm->PF.M(SafeIO(ReaderT(\s->doe<-Ex.try(restoresm)caseeofLeftexc->return(PF.Pure(Leftexc))Rightp'->return(gop'))))PF.Purer->PF.Pure(Rightr)instanceCheckPPC.ProxyCorrectwheretryp0=EitherP(gop0)wheregop=PC.Proxy(SafeIO(ReaderT(\s->doe<-Ex.try(restores(PC.unProxyp))caseeofLeftexc->return(PC.Pure(Leftexc))Rightfp->casefpofPC.Requesta'fa->return(PC.Requesta'(\a->go(faa)))PC.Respondbfb'->return(PC.Respondb(\b'->go(fb'b')))PC.Purer->return(PC.Pure(Rightr)))))instance(CheckPp)=>CheckP(P.IdentityPp)wheretry=EitherP.P.IdentityP.runEitherP.try.P.runIdentityPinstance(CheckPp)=>CheckP(R.ReaderPip)wheretryp=EitherP$R.ReaderP$\i->runEitherP$try(R.unReaderPpi)-- | Check all exceptions for a 'P.Proxy' \'@K@\'leisli arrowtryK::(CheckPp)=>(q->pa'ab'bIOr)->(q->ExceptionPpa'ab'bSafeIOr)tryK=(try.){-| Check all exceptions for an 'IO' action
'tryIO' is a monad morphism:
> tryIO $ do x <- m = do x <- tryIO m
> f x tryIO (f x)
>
> tryIO (return x) = return x -- Not true for asynchronous exceptions
-}tryIO::(P.Proxyp)=>IOr->ExceptionPpa'ab'bSafeIOrtryIOio=EitherP$P.runIdentityP$lift$SafeIO$ReaderT$\s->Ex.try$restoresio{-| Similar to 'Ex.onException' from @Control.Exception@, except this also
protects against:
* premature termination, and
* exceptions in other proxy stages.
The first argument lifts 'onAbort' to work with other base monads. Use
'id' if your base monad is already 'SafeIO'.
@(onAbort morph fin)@ is a monad morphism:
> onAbort morph fin $ do x <- m = do x <- onAbort morph fin m
> f x onAbort morph fin (f x)
>
> onAbort morph fin (return x) = return x
'onAbort' ensures finalizers are called from inside to out:
> onAbort morph fin1 . onAbort morph fin2 = onAbort morph (fin2 >> fin1)
>
> onAbort morph (return ()) = id
-}onAbort::(Monadm,P.Proxyp)=>(forallx.SafeIOx->mx)-- ^ Monad morphism->IOr'-- ^ Action to run on abort->ExceptionPpa'ab'bmr-- ^ Guarded computation->ExceptionPpa'ab'bmronAbortmorphafterp=registermorph(after>>return())p`E.catch`(\e->doP.hoistmorph$tryIOafterE.throwe){-| Analogous to 'Ex.finally' from @Control.Exception@
The first argument lifts 'finally' to work with other base monads. Use 'id'
if your base monad is already 'SafeIO'.
> finally morph after p = do
> r <- onAbort morph after p
> hoist morph $ tryIO after
> return r
-}finally::(Monadm,P.Proxyp)=>(forallx.SafeIOx->mx)-- ^ Monad morphism->IOr'-- ^ Guaranteed final action->ExceptionPpa'ab'bmr-- ^ Guarded computation->ExceptionPpa'ab'bmrfinallymorphafterp=dor<-onAbortmorphafterpP.hoistmorph$tryIOafterreturnr{-| Analogous to 'Ex.bracket' from @Control.Exception@
The first argument lifts 'bracket' to work with other base monads. Use 'id'
if your base monad is already 'SafeIO'.
'bracket' guarantees that if the resource acquisition completes, then the
resource will be released.
> bracket morph before after p = do
> h <- hoist morph $ tryIO before
> finally morph (after h) (p h)
-}bracket::(Monadm,P.Proxyp)=>(forallx.SafeIOx->mx)-- ^ Monad morphism->IOh-- ^ Acquire resource->(h->IOr')-- ^ Release resource->(h->ExceptionPpa'ab'bmr)-- ^ Use resource->ExceptionPpa'ab'bmrbracketmorphbeforeafterp=doh<-P.hoistmorph$tryIObeforefinallymorph(afterh)(ph){-| Analogous to 'Ex.bracket_' from @Control.Exception@
The first argument lifts 'bracket_' to work with any base monad. Use 'id'
if your base monad is already 'SafeIO'.
> bracket_ morph before after p = do
> hoist morph $ tryIO before
> finally morph after p
-}bracket_::(Monadm,P.Proxyp)=>(forallx.SafeIOx->mx)-- ^ Monad morphism->IOr1-- ^ Acquire resource->IOr2-- ^ Release resource->ExceptionPpa'ab'bmr-- ^ Use resource->ExceptionPpa'ab'bmrbracket_morphbeforeafterp=doP.hoistmorph$tryIObeforefinallymorphafterp{-| Analogous to 'Ex.bracketOnError' from @Control.Exception@
The first argument lifts 'bracketOnAbort' to work with any base monad. Use
'id' if your base monad is already 'SafeIO'.
> bracketOnAbort morph before after p = do
> h <- hoist morph $ tryIO before
> onAbort morph (after h) (p h)
-}bracketOnAbort::(Monadm,P.Proxyp)=>(forallx.SafeIOx->mx)-- ^ Monad morphism->IOh-- ^ Acquire resource->(h->IOr')-- ^ Release resource->(h->ExceptionPpa'ab'bmr)-- ^ Use resource->ExceptionPpa'ab'bmrbracketOnAbortmorphbeforeafterp=doh<-P.hoistmorph$tryIObeforeonAbortmorph(afterh)(ph){- $prompt
This implementation will not /promptly/ finalize a 'P.Proxy' if another
composed 'P.Proxy' prematurely terminates. However, the implementation will
still save the dropped finalizer and run it when the 'P.Session' completes
in order to guarantee deterministic finalization.
To see why, consider the following 'P.Proxy' assembly:
> p1 >-> ((p2 >-> p3) >=> p4)
Now ask yourself the question, \"If @p3@ prematurely terminates, should it
promptly finalize @p1@?\"
If you answered \"yes\", then you would have a bug if @p4@ were to
'request', which would restore control to @p1@ after we already finalized
it.
If you answered \"no\", then consider the case where @p2 = idT@ and
@p4 = return@:
> p1 >-> ((idT >-> p3) >=> return)
> p1 >-> (idT >-> p3) -- f >=> return = f
> p1 >-> p3 -- idT >-> p = p
Answering \"no\" means that @p3@ would be unable to promptly finalize a
'P.Proxy' immediately upstream of it.
There is a solution that permits perfectly prompt finalization, but it
requires indexed monads to guarantee the necessary safety through the type
system. In the absence of indexed monads, the next best solution is to let
you promptly finalize things yourself, but then /you/ must prove that this
finalization is safe and that all upstream pipes are unreachable.
The following two unsafe operations allow you to trade safety for prompt
finalization. Use them if you desire prompter finalization guarantees and
if you can prove their usage is safe. However, this proof is not trivial.
For example, you might suppose that the following usage of 'unsafeCloseU' is
safe because it never 'request's after closing upstream, nor does it
terminate:
> falseSenseOfSecurity () = do
> x <- request ()
> unsafeCloseU ()
> forever $ respond x
However, this is not safe, as the following counter-example demonstrates:
> p1 >-> ((falseSenseOfSecurity >-> request) >=> request)
@falseSenseOfSecurity@ will finalize the upstream @p1@, but then will
abort when the downstream 'request' terminates, and then the second
'request' will illegally access @p1@ after we already finalized it.
In other words, you cannot prove any prompt finalization is safe unless you
control the entire 'P.Session'. Therefore, do not use the following unsafe
operations in 'P.Proxy' libraries. Only the end user assembling the
final 'P.Session' may safely insert these calls.
-}{-| 'unsafeCloseU' calls all finalizers registered upstream of the current
'P.Proxy'.
-}unsafeCloseU::(P.Proxyp)=>r->ExceptionPpa'ab'bSafeIOrunsafeCloseUr=do(huRef,hu)<-lift$SafeIO$dohuRef<-asksupstreamhu<-lift$readIORefhuRefreturn(huRef,hu)tryIOhulift$SafeIO$lift$writeIORefhuRef(return())returnr{-| 'unsafeCloseD' calls all finalizers registered downstream of the current
'P.Proxy'.
-}unsafeCloseD::(P.Proxyp)=>r->ExceptionPpa'ab'bSafeIOrunsafeCloseDr=do(hdRef,hd)<-lift$SafeIO$dohdRef<-asksdownstreamhd<-lift$readIORefhdRefreturn(hdRef,hd)tryIOhdlift$SafeIO$lift$writeIORefhdRef(return())returnr{-| 'unsafeClose' calls all registered finalizers
'unsafeClose' is a Kleisli arrow so that you can easily seal terminating
proxies if there is a risk of delayed finalization:
> (producer >-> (takeB_ 10 >=> unsafeClose) >-> consumer) >=> later
-}unsafeClose::(P.Proxyp)=>r->ExceptionPpa'ab'bSafeIOrunsafeClose=unsafeCloseUP.>=>unsafeCloseD