{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Node.Handlers.Shutdown
  ( ShutdownOn (..)
  , parseShutdownOn

  -- * Generalised shutdown handling
  , ShutdownConfig (..)
  , withShutdownHandling

  , ShutdownTrace (..)

  -- * Watch ChainDB for passing a configured slot sync limit threshold,
  --   translating it to a graceful shutdown.
  , maybeSpawnOnSlotSyncedShutdownHandler
  )
where

import           Cardano.Prelude
import           Data.Aeson (FromJSON, ToJSON)
import           Generic.Data.Orphans ()

import           Data.Text (pack)
import qualified GHC.IO.Handle.FD as IO (fdToHandle)
import qualified Options.Applicative as Opt
import qualified System.IO as IO
import qualified System.IO.Error as IO
import           System.Posix.Types (Fd (Fd))

import           Cardano.Slotting.Slot (WithOrigin (..))
import           "contra-tracer" Control.Tracer
import           Ouroboros.Consensus.Block (Header)
import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
import           Ouroboros.Consensus.Util.ResourceRegistry (ResourceRegistry)
import           Ouroboros.Consensus.Util.STM (Watcher (..), forkLinkedWatcher)
import           Ouroboros.Network.Block (BlockNo (..), HasHeader, SlotNo (..), pointSlot)


data ShutdownOn
  = ASlot  !SlotNo
  | ABlock !BlockNo
  | NoShutdown
  deriving ((forall x. ShutdownOn -> Rep ShutdownOn x)
-> (forall x. Rep ShutdownOn x -> ShutdownOn) -> Generic ShutdownOn
forall x. Rep ShutdownOn x -> ShutdownOn
forall x. ShutdownOn -> Rep ShutdownOn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ShutdownOn x -> ShutdownOn
$cfrom :: forall x. ShutdownOn -> Rep ShutdownOn x
Generic, ShutdownOn -> ShutdownOn -> Bool
(ShutdownOn -> ShutdownOn -> Bool)
-> (ShutdownOn -> ShutdownOn -> Bool) -> Eq ShutdownOn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShutdownOn -> ShutdownOn -> Bool
$c/= :: ShutdownOn -> ShutdownOn -> Bool
== :: ShutdownOn -> ShutdownOn -> Bool
$c== :: ShutdownOn -> ShutdownOn -> Bool
Eq, Int -> ShutdownOn -> ShowS
[ShutdownOn] -> ShowS
ShutdownOn -> String
(Int -> ShutdownOn -> ShowS)
-> (ShutdownOn -> String)
-> ([ShutdownOn] -> ShowS)
-> Show ShutdownOn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShutdownOn] -> ShowS
$cshowList :: [ShutdownOn] -> ShowS
show :: ShutdownOn -> String
$cshow :: ShutdownOn -> String
showsPrec :: Int -> ShutdownOn -> ShowS
$cshowsPrec :: Int -> ShutdownOn -> ShowS
Show)

deriving instance FromJSON ShutdownOn
deriving instance ToJSON ShutdownOn

parseShutdownOn :: Opt.Parser ShutdownOn
parseShutdownOn :: Parser ShutdownOn
parseShutdownOn =
    ReadM ShutdownOn
-> Mod OptionFields ShutdownOn -> Parser ShutdownOn
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (SlotNo -> ShutdownOn
ASlot (SlotNo -> ShutdownOn)
-> (Word64 -> SlotNo) -> Word64 -> ShutdownOn
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> SlotNo
SlotNo (Word64 -> ShutdownOn) -> ReadM Word64 -> ReadM ShutdownOn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Word64
forall a. Read a => ReadM a
Opt.auto) (
         String -> Mod OptionFields ShutdownOn
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"shutdown-on-slot-synced"
      Mod OptionFields ShutdownOn
-> Mod OptionFields ShutdownOn -> Mod OptionFields ShutdownOn
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ShutdownOn
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"SLOT"
      Mod OptionFields ShutdownOn
-> Mod OptionFields ShutdownOn -> Mod OptionFields ShutdownOn
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ShutdownOn
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Shut down the process after ChainDB is synced up to the specified slot"
      Mod OptionFields ShutdownOn
-> Mod OptionFields ShutdownOn -> Mod OptionFields ShutdownOn
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields ShutdownOn
forall (f :: * -> *) a. Mod f a
Opt.hidden
    )
    Parser ShutdownOn -> Parser ShutdownOn -> Parser ShutdownOn
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    ReadM ShutdownOn
-> Mod OptionFields ShutdownOn -> Parser ShutdownOn
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option (BlockNo -> ShutdownOn
ABlock (BlockNo -> ShutdownOn)
-> (Word64 -> BlockNo) -> Word64 -> ShutdownOn
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> BlockNo
BlockNo (Word64 -> ShutdownOn) -> ReadM Word64 -> ReadM ShutdownOn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Word64
forall a. Read a => ReadM a
Opt.auto) (
         String -> Mod OptionFields ShutdownOn
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"shutdown-on-block-synced"
      Mod OptionFields ShutdownOn
-> Mod OptionFields ShutdownOn -> Mod OptionFields ShutdownOn
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ShutdownOn
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"BLOCK"
      Mod OptionFields ShutdownOn
-> Mod OptionFields ShutdownOn -> Mod OptionFields ShutdownOn
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ShutdownOn
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Shut down the process after ChainDB is synced up to the specified block"
      Mod OptionFields ShutdownOn
-> Mod OptionFields ShutdownOn -> Mod OptionFields ShutdownOn
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields ShutdownOn
forall (f :: * -> *) a. Mod f a
Opt.hidden
    )
    Parser ShutdownOn -> Parser ShutdownOn -> Parser ShutdownOn
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ShutdownOn -> Parser ShutdownOn
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShutdownOn
NoShutdown

data ShutdownTrace
  = ShutdownRequested
  -- ^ Received shutdown request
  | AbnormalShutdown
  -- ^ Non-isEOFError shutdown request
  | ShutdownUnexpectedInput Text
  -- ^ Received shutdown request but found unexpected input in --shutdown-ipc FD:
  | RequestingShutdown Text
  -- ^ Ringing the node shutdown doorbell for reason
  | ShutdownArmedAt ShutdownOn
  -- ^ Will terminate upon reaching a ChainDB sync limit
  deriving ((forall x. ShutdownTrace -> Rep ShutdownTrace x)
-> (forall x. Rep ShutdownTrace x -> ShutdownTrace)
-> Generic ShutdownTrace
forall x. Rep ShutdownTrace x -> ShutdownTrace
forall x. ShutdownTrace -> Rep ShutdownTrace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ShutdownTrace x -> ShutdownTrace
$cfrom :: forall x. ShutdownTrace -> Rep ShutdownTrace x
Generic, Value -> Parser [ShutdownTrace]
Value -> Parser ShutdownTrace
(Value -> Parser ShutdownTrace)
-> (Value -> Parser [ShutdownTrace]) -> FromJSON ShutdownTrace
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ShutdownTrace]
$cparseJSONList :: Value -> Parser [ShutdownTrace]
parseJSON :: Value -> Parser ShutdownTrace
$cparseJSON :: Value -> Parser ShutdownTrace
FromJSON, [ShutdownTrace] -> Encoding
[ShutdownTrace] -> Value
ShutdownTrace -> Encoding
ShutdownTrace -> Value
(ShutdownTrace -> Value)
-> (ShutdownTrace -> Encoding)
-> ([ShutdownTrace] -> Value)
-> ([ShutdownTrace] -> Encoding)
-> ToJSON ShutdownTrace
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ShutdownTrace] -> Encoding
$ctoEncodingList :: [ShutdownTrace] -> Encoding
toJSONList :: [ShutdownTrace] -> Value
$ctoJSONList :: [ShutdownTrace] -> Value
toEncoding :: ShutdownTrace -> Encoding
$ctoEncoding :: ShutdownTrace -> Encoding
toJSON :: ShutdownTrace -> Value
$ctoJSON :: ShutdownTrace -> Value
ToJSON)

deriving instance FromJSON BlockNo
deriving instance ToJSON BlockNo

data AndWithOrigin
  = AndWithOriginBlock (BlockNo, WithOrigin BlockNo)
  | AndWithOriginSlot (SlotNo, WithOrigin SlotNo)
  | WithoutOrigin

deriving instance Eq AndWithOrigin

data ShutdownConfig
  = ShutdownConfig
    { ShutdownConfig -> Maybe Fd
scIPC         :: !(Maybe Fd)
    , ShutdownConfig -> Maybe ShutdownOn
scOnSyncLimit :: !(Maybe ShutdownOn)
    }
    deriving (ShutdownConfig -> ShutdownConfig -> Bool
(ShutdownConfig -> ShutdownConfig -> Bool)
-> (ShutdownConfig -> ShutdownConfig -> Bool) -> Eq ShutdownConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShutdownConfig -> ShutdownConfig -> Bool
$c/= :: ShutdownConfig -> ShutdownConfig -> Bool
== :: ShutdownConfig -> ShutdownConfig -> Bool
$c== :: ShutdownConfig -> ShutdownConfig -> Bool
Eq, Int -> ShutdownConfig -> ShowS
[ShutdownConfig] -> ShowS
ShutdownConfig -> String
(Int -> ShutdownConfig -> ShowS)
-> (ShutdownConfig -> String)
-> ([ShutdownConfig] -> ShowS)
-> Show ShutdownConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShutdownConfig] -> ShowS
$cshowList :: [ShutdownConfig] -> ShowS
show :: ShutdownConfig -> String
$cshow :: ShutdownConfig -> String
showsPrec :: Int -> ShutdownConfig -> ShowS
$cshowsPrec :: Int -> ShutdownConfig -> ShowS
Show)

-- | We provide an optional cross-platform method to politely request shut down.
-- The parent process passes us the file descriptor number of the read end of a pipe,
-- via the CLI with @--shutdown-ipc FD@
withShutdownHandling
  :: ShutdownConfig
  -> Tracer IO ShutdownTrace
  -> IO ()
  -- ^ Action to potentially shutdown via file descriptor
  -> IO ()
withShutdownHandling :: ShutdownConfig -> Tracer IO ShutdownTrace -> IO () -> IO ()
withShutdownHandling ShutdownConfig{scIPC :: ShutdownConfig -> Maybe Fd
scIPC = Maybe Fd
Nothing} Tracer IO ShutdownTrace
_ IO ()
action = IO ()
action
withShutdownHandling ShutdownConfig{scIPC :: ShutdownConfig -> Maybe Fd
scIPC = Just Fd
fd} Tracer IO ShutdownTrace
tr IO ()
action = do
  IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO ()
race_ (Fd -> IO ()
waitForEOF Fd
fd) IO ()
action
 where
   waitForEOF :: Fd -> IO ()
   waitForEOF :: Fd -> IO ()
waitForEOF (Fd CInt
fileDesc) = do
     Handle
hnd <- CInt -> IO Handle
IO.fdToHandle CInt
fileDesc
     Either IOError Char
r <- IO Char -> IO (Either IOError Char)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO Char -> IO (Either IOError Char))
-> IO Char -> IO (Either IOError Char)
forall a b. (a -> b) -> a -> b
$ Handle -> IO Char
IO.hGetChar Handle
hnd
     case Either IOError Char
r of
       Left IOError
e
         | IOError -> Bool
IO.isEOFError IOError
e ->
             Tracer IO ShutdownTrace -> ShutdownTrace -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO ShutdownTrace
tr ShutdownTrace
ShutdownRequested
         | Bool
otherwise -> do
             Tracer IO ShutdownTrace -> ShutdownTrace -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO ShutdownTrace
tr ShutdownTrace
AbnormalShutdown
             IOError -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO IOError
e
       Right Char
inp  ->
         Tracer IO ShutdownTrace -> ShutdownTrace -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO ShutdownTrace
tr (Text -> ShutdownTrace
ShutdownUnexpectedInput (Text -> ShutdownTrace)
-> (String -> Text) -> String -> ShutdownTrace
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
pack (String -> ShutdownTrace) -> String -> ShutdownTrace
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Char
inp)

-- | Spawn a thread that would cause node to shutdown upon ChainDB reaching the
-- configuration-defined slot.
maybeSpawnOnSlotSyncedShutdownHandler
  :: HasHeader (Header blk)
  => ShutdownConfig
  -> Tracer IO ShutdownTrace
  -> ResourceRegistry IO
  -> ChainDB.ChainDB IO blk
  -> IO ()
maybeSpawnOnSlotSyncedShutdownHandler :: ShutdownConfig
-> Tracer IO ShutdownTrace
-> ResourceRegistry IO
-> ChainDB IO blk
-> IO ()
maybeSpawnOnSlotSyncedShutdownHandler ShutdownConfig
sc Tracer IO ShutdownTrace
tr ResourceRegistry IO
registry ChainDB IO blk
chaindb =
  case ShutdownConfig -> Maybe ShutdownOn
scOnSyncLimit ShutdownConfig
sc of
    Maybe ShutdownOn
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just ShutdownOn
lim -> do
      Tracer IO ShutdownTrace -> ShutdownTrace -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO ShutdownTrace
tr (ShutdownOn -> ShutdownTrace
ShutdownArmedAt ShutdownOn
lim)
      ShutdownOn -> IO ()
spawnLimitTerminator ShutdownOn
lim
 where
  spawnLimitTerminator :: ShutdownOn -> IO ()
  spawnLimitTerminator :: ShutdownOn -> IO ()
spawnLimitTerminator ShutdownOn
limit =
    IO (Thread IO Void) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Thread IO Void) -> IO ()) -> IO (Thread IO Void) -> IO ()
forall a b. (a -> b) -> a -> b
$ ResourceRegistry IO
-> String
-> Watcher IO AndWithOrigin AndWithOrigin
-> IO (Thread IO Void)
forall (m :: * -> *) a fp.
(IOLike m, Eq fp, HasCallStack) =>
ResourceRegistry m -> String -> Watcher m a fp -> m (Thread m Void)
forkLinkedWatcher ResourceRegistry IO
registry String
"slotLimitTerminator" Watcher :: forall (m :: * -> *) a fp.
(a -> fp) -> Maybe fp -> (a -> m ()) -> STM m a -> Watcher m a fp
Watcher {
        wFingerprint :: AndWithOrigin -> AndWithOrigin
wFingerprint = AndWithOrigin -> AndWithOrigin
forall (cat :: * -> * -> *) a. Category cat => cat a a
identity
      , wInitial :: Maybe AndWithOrigin
wInitial     = Maybe AndWithOrigin
forall a. Maybe a
Nothing
      , wReader :: STM IO AndWithOrigin
wReader      =
          case ShutdownOn
limit of
            ASlot   SlotNo
x -> (SlotNo, WithOrigin SlotNo) -> AndWithOrigin
AndWithOriginSlot ((SlotNo, WithOrigin SlotNo) -> AndWithOrigin)
-> (Point blk -> (SlotNo, WithOrigin SlotNo))
-> Point blk
-> AndWithOrigin
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (SlotNo
x,) (WithOrigin SlotNo -> (SlotNo, WithOrigin SlotNo))
-> (Point blk -> WithOrigin SlotNo)
-> Point blk
-> (SlotNo, WithOrigin SlotNo)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Point blk -> WithOrigin SlotNo
forall block. Point block -> WithOrigin SlotNo
pointSlot (Point blk -> AndWithOrigin)
-> STM (Point blk) -> STM AndWithOrigin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChainDB IO blk -> STM IO (Point blk)
forall (m :: * -> *) blk. ChainDB m blk -> STM m (Point blk)
ChainDB.getTipPoint ChainDB IO blk
chaindb
            ABlock  BlockNo
x -> (BlockNo, WithOrigin BlockNo) -> AndWithOrigin
AndWithOriginBlock ((BlockNo, WithOrigin BlockNo) -> AndWithOrigin)
-> (WithOrigin BlockNo -> (BlockNo, WithOrigin BlockNo))
-> WithOrigin BlockNo
-> AndWithOrigin
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (BlockNo
x,) (WithOrigin BlockNo -> AndWithOrigin)
-> STM (WithOrigin BlockNo) -> STM AndWithOrigin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChainDB IO blk -> STM IO (WithOrigin BlockNo)
forall (m :: * -> *) blk.
(Monad (STM m), HasHeader (Header blk)) =>
ChainDB m blk -> STM m (WithOrigin BlockNo)
ChainDB.getTipBlockNo ChainDB IO blk
chaindb
            ShutdownOn
NoShutdown -> AndWithOrigin -> STM AndWithOrigin
forall (m :: * -> *) a. Monad m => a -> m a
return AndWithOrigin
WithoutOrigin
      , wNotify :: AndWithOrigin -> IO ()
wNotify      = \case
          (AndWithOriginSlot (SlotNo
lim, At SlotNo
cur)) ->
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SlotNo
cur SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
>= SlotNo
lim) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Tracer IO ShutdownTrace -> ShutdownTrace -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO ShutdownTrace
tr (Text -> ShutdownTrace
RequestingShutdown (Text -> ShutdownTrace) -> Text -> ShutdownTrace
forall a b. (a -> b) -> a -> b
$ Text
"spawnLimitTerminator: reached target slot "
                              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack (String -> Text) -> (SlotNo -> String) -> SlotNo -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SlotNo -> String
forall a b. (Show a, ConvertText String b) => a -> b
show) SlotNo
cur)
                ExitCode -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO ExitCode
ExitSuccess
          (AndWithOriginBlock (BlockNo
lim, At BlockNo
cur)) ->
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BlockNo
cur BlockNo -> BlockNo -> Bool
forall a. Ord a => a -> a -> Bool
>= BlockNo
lim) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Tracer IO ShutdownTrace -> ShutdownTrace -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO ShutdownTrace
tr (Text -> ShutdownTrace
RequestingShutdown (Text -> ShutdownTrace) -> Text -> ShutdownTrace
forall a b. (a -> b) -> a -> b
$ Text
"spawnLimitTerminator: reached target block "
                              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack (String -> Text) -> (BlockNo -> String) -> BlockNo -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BlockNo -> String
forall a b. (Show a, ConvertText String b) => a -> b
show) BlockNo
cur)
                ExitCode -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO ExitCode
ExitSuccess
          AndWithOrigin
WithoutOrigin -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          AndWithOrigin
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      }