    module Hackage.Security.Client.Verify (
        -- * Verification monad
        Verify -- opaque
      , runVerify
      , acquire
      , ifVerified
        -- * Specific resources
      , openTempFile
        -- * Re-exports
      , liftIO
      ) where

    import Prelude
    import Control.Exception
    import Control.Monad (join, void)
    import Control.Monad.IO.Class (MonadIO, liftIO)
    import Control.Monad.Reader (ReaderT, runReaderT, ask)
    import Data.IORef

    import Hackage.Security.Util.IO
    import Hackage.Security.Util.Path

    {-------------------------------------------------------------------------------
      Verification monad
    -------------------------------------------------------------------------------}

    type Finaliser = IO ()
    type Cleanup   = IO ()

    -- | Verification monad
    --
    -- The verification monad is similar to 'ResourceT' in intent, in that we can
    -- register handlers to be run to release resources. Unlike 'ResourceT',
    -- however, we maintain _two_ handlers: a cleanup handler which is run  whether
    -- or not verification succeeds, and a finalisation handler which is run only if
    -- verification succeeds.
    --
    -- * Cleanup handlers are registered using 'acquire', and are guaranteed to run
    --   just before the computation terminates (after the finalisation handler).
    -- * The finalisation handlers are run only when verification succeeds, and can
    --   be registered with 'ifVerified'. Finalisation can be used for instance to
    --   update the local cache (which should only happen if verification is
    --   successful).
    newtype Verify a = Verify {
        forall a. Verify a -> ReaderT (IORef Cleanup, IORef Cleanup) IO a
    unVerify :: ReaderT (IORef Cleanup, IORef Finaliser) IO a
      }
      deriving ((forall a b. (a -> b) -> Verify a -> Verify b)
    -> (forall a b. a -> Verify b -> Verify a) -> Functor Verify
    forall a b. a -> Verify b -> Verify a
    forall a b. (a -> b) -> Verify a -> Verify b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> Verify a -> Verify b
    fmap :: forall a b. (a -> b) -> Verify a -> Verify b
    $c<$ :: forall a b. a -> Verify b -> Verify a
    <$ :: forall a b. a -> Verify b -> Verify a
    Functor, Functor Verify
    Functor Verify =>
    (forall a. a -> Verify a)
    -> (forall a b. Verify (a -> b) -> Verify a -> Verify b)
    -> (forall a b c.
        (a -> b -> c) -> Verify a -> Verify b -> Verify c)
    -> (forall a b. Verify a -> Verify b -> Verify b)
    -> (forall a b. Verify a -> Verify b -> Verify a)
    -> Applicative Verify
    forall a. a -> Verify a
    forall a b. Verify a -> Verify b -> Verify a
    forall a b. Verify a -> Verify b -> Verify b
    forall a b. Verify (a -> b) -> Verify a -> Verify b
    forall a b c. (a -> b -> c) -> Verify a -> Verify b -> Verify c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall a. a -> Verify a
    pure :: forall a. a -> Verify a
    $c<*> :: forall a b. Verify (a -> b) -> Verify a -> Verify b
    <*> :: forall a b. Verify (a -> b) -> Verify a -> Verify b
    $cliftA2 :: forall a b c. (a -> b -> c) -> Verify a -> Verify b -> Verify c
    liftA2 :: forall a b c. (a -> b -> c) -> Verify a -> Verify b -> Verify c
    $c*> :: forall a b. Verify a -> Verify b -> Verify b
    *> :: forall a b. Verify a -> Verify b -> Verify b
    $c<* :: forall a b. Verify a -> Verify b -> Verify a
    <* :: forall a b. Verify a -> Verify b -> Verify a
    Applicative, Applicative Verify
    Applicative Verify =>
    (forall a b. Verify a -> (a -> Verify b) -> Verify b)
    -> (forall a b. Verify a -> Verify b -> Verify b)
    -> (forall a. a -> Verify a)
    -> Monad Verify
    forall a. a -> Verify a
    forall a b. Verify a -> Verify b -> Verify b
    forall a b. Verify a -> (a -> Verify b) -> Verify b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall a b. Verify a -> (a -> Verify b) -> Verify b
    >>= :: forall a b. Verify a -> (a -> Verify b) -> Verify b
    $c>> :: forall a b. Verify a -> Verify b -> Verify b
    >> :: forall a b. Verify a -> Verify b -> Verify b
    $creturn :: forall a. a -> Verify a
    return :: forall a. a -> Verify a
    Monad, Monad Verify
    Monad Verify => (forall a. IO a -> Verify a) -> MonadIO Verify
    forall a. IO a -> Verify a
    forall (m :: * -> *).
    Monad m =>
    (forall a. IO a -> m a) -> MonadIO m
    $cliftIO :: forall a. IO a -> Verify a
    liftIO :: forall a. IO a -> Verify a
    MonadIO)

    -- | Run an action in the 'Verify' monad
    runVerify :: (Finaliser -> Finaliser) -> Verify a -> IO a
    runVerify :: forall a. (Cleanup -> Cleanup) -> Verify a -> IO a
    runVerify Cleanup -> Cleanup
    modifyFinaliser Verify a
    v = do
        rCleanup   <- Cleanup -> IO (IORef Cleanup)
    forall a. a -> IO (IORef a)
    newIORef (Cleanup -> IO (IORef Cleanup)) -> Cleanup -> IO (IORef Cleanup)
    forall a b. (a -> b) -> a -> b
    $ () -> Cleanup
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        rFinaliser <- newIORef $ return ()
        mask $ \forall a. IO a -> IO a
    restore -> do
          ma <- IO a -> IO (Either SomeException a)
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IO a -> IO (Either SomeException a))
    -> IO a -> IO (Either SomeException a)
    forall a b. (a -> b) -> a -> b
    $ IO a -> IO a
    forall a. IO a -> IO a
    restore (IO a -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ ReaderT (IORef Cleanup, IORef Cleanup) IO a
    -> (IORef Cleanup, IORef Cleanup) -> IO a
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT (Verify a -> ReaderT (IORef Cleanup, IORef Cleanup) IO a
    forall a. Verify a -> ReaderT (IORef Cleanup, IORef Cleanup) IO a
    unVerify Verify a
    v) (IORef Cleanup
    rCleanup, IORef Cleanup
    rFinaliser)
          case ma of
            Left SomeException
    ex -> do IO Cleanup -> Cleanup
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (IO Cleanup -> Cleanup) -> IO Cleanup -> Cleanup
    forall a b. (a -> b) -> a -> b
    $ IORef Cleanup -> IO Cleanup
    forall a. IORef a -> IO a
    readIORef IORef Cleanup
    rCleanup
                          SomeException -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (SomeException
    ex :: SomeException)
            Right a
    a -> do Cleanup -> Cleanup
    modifyFinaliser (Cleanup -> Cleanup) -> Cleanup -> Cleanup
    forall a b. (a -> b) -> a -> b
    $ IO Cleanup -> Cleanup
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (IO Cleanup -> Cleanup) -> IO Cleanup -> Cleanup
    forall a b. (a -> b) -> a -> b
    $ IORef Cleanup -> IO Cleanup
    forall a. IORef a -> IO a
    readIORef IORef Cleanup
    rFinaliser
                          IO Cleanup -> Cleanup
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (IO Cleanup -> Cleanup) -> IO Cleanup -> Cleanup
    forall a b. (a -> b) -> a -> b
    $ IORef Cleanup -> IO Cleanup
    forall a. IORef a -> IO a
    readIORef IORef Cleanup
    rCleanup
                          a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a

    -- | Acquire a resource and register the corresponding cleanup handler
    --
    -- NOTE: Resource acquisition happens with exceptions masked. If it is important
    -- that the resource acquistion can be timed out (or receive other kinds of
    -- asynchronous exceptions), you will need to use an interruptible operation.
    -- See <http://www.well-typed.com/blog/2014/08/asynchronous-exceptions/> for
    -- details.
    acquire :: IO a -> (a -> IO ()) -> Verify a
    acquire :: forall a. IO a -> (a -> Cleanup) -> Verify a
    acquire IO a
    get a -> Cleanup
    release = ReaderT (IORef Cleanup, IORef Cleanup) IO a -> Verify a
    forall a. ReaderT (IORef Cleanup, IORef Cleanup) IO a -> Verify a
    Verify (ReaderT (IORef Cleanup, IORef Cleanup) IO a -> Verify a)
    -> ReaderT (IORef Cleanup, IORef Cleanup) IO a -> Verify a
    forall a b. (a -> b) -> a -> b
    $ do
        (rCleanup, _rFinaliser) <- ReaderT
      (IORef Cleanup, IORef Cleanup) IO (IORef Cleanup, IORef Cleanup)
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        liftIO $ mask_ $ do
          a <- liftIO get
          modifyIORef rCleanup (>> release a)
          return a

    -- | Register an action to be run only if verification succeeds
    ifVerified :: IO () -> Verify ()
    ifVerified :: Cleanup -> Verify ()
    ifVerified Cleanup
    handler = ReaderT (IORef Cleanup, IORef Cleanup) IO () -> Verify ()
    forall a. ReaderT (IORef Cleanup, IORef Cleanup) IO a -> Verify a
    Verify (ReaderT (IORef Cleanup, IORef Cleanup) IO () -> Verify ())
    -> ReaderT (IORef Cleanup, IORef Cleanup) IO () -> Verify ()
    forall a b. (a -> b) -> a -> b
    $ do
        (_rCleanup, rFinaliser) <- ReaderT
      (IORef Cleanup, IORef Cleanup) IO (IORef Cleanup, IORef Cleanup)
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        liftIO $ modifyIORef rFinaliser (>> handler)

    {-------------------------------------------------------------------------------
      Specific resources
    -------------------------------------------------------------------------------}

    -- | Create a short-lived temporary file
    --
    -- Creates the directory where the temp file should live if it does not exist.
    openTempFile :: FsRoot root
                 => Path root  -- ^ Temp directory
                 -> String     -- ^ Template
                 -> Verify (Path Absolute, Handle)
    openTempFile :: forall root.
    FsRoot root =>
    Path root -> String -> Verify (Path Absolute, Handle)
    openTempFile Path root
    tmpDir String
    template =
        IO (Path Absolute, Handle)
    -> ((Path Absolute, Handle) -> Cleanup)
    -> Verify (Path Absolute, Handle)
    forall a. IO a -> (a -> Cleanup) -> Verify a
    acquire IO (Path Absolute, Handle)
    createTempFile (Path Absolute, Handle) -> Cleanup
    closeAndDelete
      where
        createTempFile :: IO (Path Absolute, Handle)
        createTempFile :: IO (Path Absolute, Handle)
    createTempFile = do
          Bool -> Path root -> Cleanup
    forall root. FsRoot root => Bool -> Path root -> Cleanup
    createDirectoryIfMissing Bool
    True Path root
    tmpDir
          Path root -> String -> IO (Path Absolute, Handle)
    forall root.
    FsRoot root =>
    Path root -> String -> IO (Path Absolute, Handle)
    openTempFile' Path root
    tmpDir String
    template

        closeAndDelete :: (Path Absolute, Handle) -> IO ()
        closeAndDelete :: (Path Absolute, Handle) -> Cleanup
    closeAndDelete (Path Absolute
    fp, Handle
    h) = do
          Handle -> Cleanup
    hClose Handle
    h
          IO (Maybe ()) -> Cleanup
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Maybe ()) -> Cleanup) -> IO (Maybe ()) -> Cleanup
    forall a b. (a -> b) -> a -> b
    $ Cleanup -> IO (Maybe ())
    forall a. IO a -> IO (Maybe a)
    handleDoesNotExist (Cleanup -> IO (Maybe ())) -> Cleanup -> IO (Maybe ())
    forall a b. (a -> b) -> a -> b
    $ Path Absolute -> Cleanup
    forall root. FsRoot root => Path root -> Cleanup
    removeFile Path Absolute
    fp