{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Ouroboros.Network.Protocol.LocalStateQuery.Examples where

import Ouroboros.Network.Protocol.LocalStateQuery.Client
import Ouroboros.Network.Protocol.LocalStateQuery.Server
import Ouroboros.Network.Protocol.LocalStateQuery.Type (AcquireFailure (..),
           Target)


--
-- Example client
--

-- | An example 'LocalStateQueryClient', which, for each point in the given
-- list, acquires the state for that point, and if that succeeds, returns the
-- result for the corresponding query. When the state could not be acquired,
-- the 'AcquireFailure' is returned instead of the query results.
--
localStateQueryClient
  :: forall block point query result m.
     Applicative m
  => [(Target point, query result)]
  -> LocalStateQueryClient block point query m
                           [(Target point, Either AcquireFailure result)]
localStateQueryClient :: forall block point (query :: * -> *) result (m :: * -> *).
Applicative m =>
[(Target point, query result)]
-> LocalStateQueryClient
     block point query m [(Target point, Either AcquireFailure result)]
localStateQueryClient = m (ClientStIdle
     block point query m [(Target point, Either AcquireFailure result)])
-> LocalStateQueryClient
     block point query m [(Target point, Either AcquireFailure result)]
forall block point (query :: * -> *) (m :: * -> *) a.
m (ClientStIdle block point query m a)
-> LocalStateQueryClient block point query m a
LocalStateQueryClient (m (ClientStIdle
      block point query m [(Target point, Either AcquireFailure result)])
 -> LocalStateQueryClient
      block point query m [(Target point, Either AcquireFailure result)])
-> ([(Target point, query result)]
    -> m (ClientStIdle
            block
            point
            query
            m
            [(Target point, Either AcquireFailure result)]))
-> [(Target point, query result)]
-> LocalStateQueryClient
     block point query m [(Target point, Either AcquireFailure result)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientStIdle
  block point query m [(Target point, Either AcquireFailure result)]
-> m (ClientStIdle
        block point query m [(Target point, Either AcquireFailure result)])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStIdle
   block point query m [(Target point, Either AcquireFailure result)]
 -> m (ClientStIdle
         block
         point
         query
         m
         [(Target point, Either AcquireFailure result)]))
-> ([(Target point, query result)]
    -> ClientStIdle
         block point query m [(Target point, Either AcquireFailure result)])
-> [(Target point, query result)]
-> m (ClientStIdle
        block point query m [(Target point, Either AcquireFailure result)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Target point, Either AcquireFailure result)]
-> [(Target point, query result)]
-> ClientStIdle
     block point query m [(Target point, Either AcquireFailure result)]
goIdle []
  where
    goIdle
      :: [(Target point, Either AcquireFailure result)]  -- ^ Accumulator
      -> [(Target point, query result)]                  -- ^ Remainder
      -> ClientStIdle block point query m
                      [(Target point, Either AcquireFailure result)]
    goIdle :: [(Target point, Either AcquireFailure result)]
-> [(Target point, query result)]
-> ClientStIdle
     block point query m [(Target point, Either AcquireFailure result)]
goIdle [(Target point, Either AcquireFailure result)]
acc []               = [(Target point, Either AcquireFailure result)]
-> ClientStIdle
     block point query m [(Target point, Either AcquireFailure result)]
forall a block point (query :: * -> *) (m :: * -> *).
a -> ClientStIdle block point query m a
SendMsgDone ([(Target point, Either AcquireFailure result)]
 -> ClientStIdle
      block point query m [(Target point, Either AcquireFailure result)])
-> [(Target point, Either AcquireFailure result)]
-> ClientStIdle
     block point query m [(Target point, Either AcquireFailure result)]
forall a b. (a -> b) -> a -> b
$ [(Target point, Either AcquireFailure result)]
-> [(Target point, Either AcquireFailure result)]
forall a. [a] -> [a]
reverse [(Target point, Either AcquireFailure result)]
acc
    goIdle [(Target point, Either AcquireFailure result)]
acc ((Target point
tgt, query result
q):[(Target point, query result)]
ptqs') = Target point
-> ClientStAcquiring
     block point query m [(Target point, Either AcquireFailure result)]
-> ClientStIdle
     block point query m [(Target point, Either AcquireFailure result)]
forall point block (query :: * -> *) (m :: * -> *) a.
Target point
-> ClientStAcquiring block point query m a
-> ClientStIdle block point query m a
SendMsgAcquire Target point
tgt (ClientStAcquiring
   block point query m [(Target point, Either AcquireFailure result)]
 -> ClientStIdle
      block point query m [(Target point, Either AcquireFailure result)])
-> ClientStAcquiring
     block point query m [(Target point, Either AcquireFailure result)]
-> ClientStIdle
     block point query m [(Target point, Either AcquireFailure result)]
forall a b. (a -> b) -> a -> b
$
      [(Target point, Either AcquireFailure result)]
-> Target point
-> query result
-> [(Target point, query result)]
-> ClientStAcquiring
     block point query m [(Target point, Either AcquireFailure result)]
goAcquiring [(Target point, Either AcquireFailure result)]
acc Target point
tgt query result
q [(Target point, query result)]
ptqs'

    goAcquiring
      :: [(Target point, Either AcquireFailure result)]  -- ^ Accumulator
      -> Target point
      -> query result
      -> [(Target point, query result)]                  -- ^ Remainder
      -> ClientStAcquiring block point query m
                           [(Target point, Either AcquireFailure result)]
    goAcquiring :: [(Target point, Either AcquireFailure result)]
-> Target point
-> query result
-> [(Target point, query result)]
-> ClientStAcquiring
     block point query m [(Target point, Either AcquireFailure result)]
goAcquiring [(Target point, Either AcquireFailure result)]
acc Target point
pt query result
q [(Target point, query result)]
ptqss' = ClientStAcquiring {
        recvMsgAcquired :: m (ClientStAcquired
     block point query m [(Target point, Either AcquireFailure result)])
recvMsgAcquired = ClientStAcquired
  block point query m [(Target point, Either AcquireFailure result)]
-> m (ClientStAcquired
        block point query m [(Target point, Either AcquireFailure result)])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStAcquired
   block point query m [(Target point, Either AcquireFailure result)]
 -> m (ClientStAcquired
         block
         point
         query
         m
         [(Target point, Either AcquireFailure result)]))
-> ClientStAcquired
     block point query m [(Target point, Either AcquireFailure result)]
-> m (ClientStAcquired
        block point query m [(Target point, Either AcquireFailure result)])
forall a b. (a -> b) -> a -> b
$ query result
-> (result
    -> ClientStAcquired
         block point query m [(Target point, Either AcquireFailure result)])
-> ClientStAcquired
     block point query m [(Target point, Either AcquireFailure result)]
forall a.
query result
-> (result -> ClientStAcquired block point query m a)
-> ClientStAcquired block point query m a
goQuery query result
q ((result
  -> ClientStAcquired
       block point query m [(Target point, Either AcquireFailure result)])
 -> ClientStAcquired
      block point query m [(Target point, Either AcquireFailure result)])
-> (result
    -> ClientStAcquired
         block point query m [(Target point, Either AcquireFailure result)])
-> ClientStAcquired
     block point query m [(Target point, Either AcquireFailure result)]
forall a b. (a -> b) -> a -> b
$ \result
r -> [(Target point, Either AcquireFailure result)]
-> [(Target point, query result)]
-> ClientStAcquired
     block point query m [(Target point, Either AcquireFailure result)]
goAcquired ((Target point
pt, result -> Either AcquireFailure result
forall a b. b -> Either a b
Right result
r)(Target point, Either AcquireFailure result)
-> [(Target point, Either AcquireFailure result)]
-> [(Target point, Either AcquireFailure result)]
forall a. a -> [a] -> [a]
:[(Target point, Either AcquireFailure result)]
acc) [(Target point, query result)]
ptqss'
      , recvMsgFailure :: AcquireFailure
-> m (ClientStIdle
        block point query m [(Target point, Either AcquireFailure result)])
recvMsgFailure  = \AcquireFailure
failure -> ClientStIdle
  block point query m [(Target point, Either AcquireFailure result)]
-> m (ClientStIdle
        block point query m [(Target point, Either AcquireFailure result)])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStIdle
   block point query m [(Target point, Either AcquireFailure result)]
 -> m (ClientStIdle
         block
         point
         query
         m
         [(Target point, Either AcquireFailure result)]))
-> ClientStIdle
     block point query m [(Target point, Either AcquireFailure result)]
-> m (ClientStIdle
        block point query m [(Target point, Either AcquireFailure result)])
forall a b. (a -> b) -> a -> b
$ [(Target point, Either AcquireFailure result)]
-> [(Target point, query result)]
-> ClientStIdle
     block point query m [(Target point, Either AcquireFailure result)]
goIdle ((Target point
pt, AcquireFailure -> Either AcquireFailure result
forall a b. a -> Either a b
Left AcquireFailure
failure)(Target point, Either AcquireFailure result)
-> [(Target point, Either AcquireFailure result)]
-> [(Target point, Either AcquireFailure result)]
forall a. a -> [a] -> [a]
:[(Target point, Either AcquireFailure result)]
acc) [(Target point, query result)]
ptqss'
      }

    goAcquired
      :: [(Target point, Either AcquireFailure result)]
      -> [(Target point, query result)]   -- ^ Remainder
      -> ClientStAcquired block point query m
                          [(Target point, Either AcquireFailure result)]
    goAcquired :: [(Target point, Either AcquireFailure result)]
-> [(Target point, query result)]
-> ClientStAcquired
     block point query m [(Target point, Either AcquireFailure result)]
goAcquired [(Target point, Either AcquireFailure result)]
acc [] = m (ClientStIdle
     block point query m [(Target point, Either AcquireFailure result)])
-> ClientStAcquired
     block point query m [(Target point, Either AcquireFailure result)]
forall (m :: * -> *) block point (query :: * -> *) a.
m (ClientStIdle block point query m a)
-> ClientStAcquired block point query m a
SendMsgRelease (m (ClientStIdle
      block point query m [(Target point, Either AcquireFailure result)])
 -> ClientStAcquired
      block point query m [(Target point, Either AcquireFailure result)])
-> m (ClientStIdle
        block point query m [(Target point, Either AcquireFailure result)])
-> ClientStAcquired
     block point query m [(Target point, Either AcquireFailure result)]
forall a b. (a -> b) -> a -> b
$ ClientStIdle
  block point query m [(Target point, Either AcquireFailure result)]
-> m (ClientStIdle
        block point query m [(Target point, Either AcquireFailure result)])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStIdle
   block point query m [(Target point, Either AcquireFailure result)]
 -> m (ClientStIdle
         block
         point
         query
         m
         [(Target point, Either AcquireFailure result)]))
-> ClientStIdle
     block point query m [(Target point, Either AcquireFailure result)]
-> m (ClientStIdle
        block point query m [(Target point, Either AcquireFailure result)])
forall a b. (a -> b) -> a -> b
$ [(Target point, Either AcquireFailure result)]
-> ClientStIdle
     block point query m [(Target point, Either AcquireFailure result)]
forall a block point (query :: * -> *) (m :: * -> *).
a -> ClientStIdle block point query m a
SendMsgDone ([(Target point, Either AcquireFailure result)]
 -> ClientStIdle
      block point query m [(Target point, Either AcquireFailure result)])
-> [(Target point, Either AcquireFailure result)]
-> ClientStIdle
     block point query m [(Target point, Either AcquireFailure result)]
forall a b. (a -> b) -> a -> b
$ [(Target point, Either AcquireFailure result)]
-> [(Target point, Either AcquireFailure result)]
forall a. [a] -> [a]
reverse [(Target point, Either AcquireFailure result)]
acc
    goAcquired [(Target point, Either AcquireFailure result)]
acc ((Target point
tgt, query result
qs):[(Target point, query result)]
ptqss') = Target point
-> ClientStAcquiring
     block point query m [(Target point, Either AcquireFailure result)]
-> ClientStAcquired
     block point query m [(Target point, Either AcquireFailure result)]
forall point block (query :: * -> *) (m :: * -> *) a.
Target point
-> ClientStAcquiring block point query m a
-> ClientStAcquired block point query m a
SendMsgReAcquire Target point
tgt (ClientStAcquiring
   block point query m [(Target point, Either AcquireFailure result)]
 -> ClientStAcquired
      block point query m [(Target point, Either AcquireFailure result)])
-> ClientStAcquiring
     block point query m [(Target point, Either AcquireFailure result)]
-> ClientStAcquired
     block point query m [(Target point, Either AcquireFailure result)]
forall a b. (a -> b) -> a -> b
$
      [(Target point, Either AcquireFailure result)]
-> Target point
-> query result
-> [(Target point, query result)]
-> ClientStAcquiring
     block point query m [(Target point, Either AcquireFailure result)]
goAcquiring [(Target point, Either AcquireFailure result)]
acc Target point
tgt query result
qs [(Target point, query result)]
ptqss'

    goQuery
      :: forall a.
         query result
      -> (result -> ClientStAcquired block point query m a)
         -- ^ Continuation
      -> ClientStAcquired block point query m a
    goQuery :: forall a.
query result
-> (result -> ClientStAcquired block point query m a)
-> ClientStAcquired block point query m a
goQuery query result
q result -> ClientStAcquired block point query m a
k = query result
-> ClientStQuerying block point query m a result
-> ClientStAcquired block point query m a
forall (query :: * -> *) result block point (m :: * -> *) a.
query result
-> ClientStQuerying block point query m a result
-> ClientStAcquired block point query m a
SendMsgQuery query result
q (ClientStQuerying block point query m a result
 -> ClientStAcquired block point query m a)
-> ClientStQuerying block point query m a result
-> ClientStAcquired block point query m a
forall a b. (a -> b) -> a -> b
$ (result -> m (ClientStAcquired block point query m a))
-> ClientStQuerying block point query m a result
forall block point (query :: * -> *) (m :: * -> *) a result.
(result -> m (ClientStAcquired block point query m a))
-> ClientStQuerying block point query m a result
ClientStQuerying ((result -> m (ClientStAcquired block point query m a))
 -> ClientStQuerying block point query m a result)
-> (result -> m (ClientStAcquired block point query m a))
-> ClientStQuerying block point query m a result
forall a b. (a -> b) -> a -> b
$ \result
r -> ClientStAcquired block point query m a
-> m (ClientStAcquired block point query m a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStAcquired block point query m a
 -> m (ClientStAcquired block point query m a))
-> ClientStAcquired block point query m a
-> m (ClientStAcquired block point query m a)
forall a b. (a -> b) -> a -> b
$ result -> ClientStAcquired block point query m a
k result
r

--
-- Example server
--

-- | An example 'LocalStateQueryServer'. The first function is called to
-- acquire a @state@, after which the second will be used to query the state.
--
localStateQueryServer
  :: forall block point query m state. Applicative m
  => (Target point -> Either AcquireFailure state)
  -> (forall result. state -> query result -> result)
  -> LocalStateQueryServer block point query m ()
localStateQueryServer :: forall block point (query :: * -> *) (m :: * -> *) state.
Applicative m =>
(Target point -> Either AcquireFailure state)
-> (forall result. state -> query result -> result)
-> LocalStateQueryServer block point query m ()
localStateQueryServer Target point -> Either AcquireFailure state
acquire forall result. state -> query result -> result
answer =
    m (ServerStIdle block point query m ())
-> LocalStateQueryServer block point query m ()
forall block point (query :: * -> *) (m :: * -> *) a.
m (ServerStIdle block point query m a)
-> LocalStateQueryServer block point query m a
LocalStateQueryServer (m (ServerStIdle block point query m ())
 -> LocalStateQueryServer block point query m ())
-> m (ServerStIdle block point query m ())
-> LocalStateQueryServer block point query m ()
forall a b. (a -> b) -> a -> b
$ ServerStIdle block point query m ()
-> m (ServerStIdle block point query m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStIdle block point query m ()
goIdle
  where
    goIdle :: ServerStIdle block point query m ()
    goIdle :: ServerStIdle block point query m ()
goIdle = ServerStIdle {
        recvMsgAcquire :: Target point -> m (ServerStAcquiring block point query m ())
recvMsgAcquire = Target point -> m (ServerStAcquiring block point query m ())
goAcquiring
      , recvMsgDone :: m ()
recvMsgDone    = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      }

    goAcquiring :: Target point -> m (ServerStAcquiring block point query m ())
    goAcquiring :: Target point -> m (ServerStAcquiring block point query m ())
goAcquiring Target point
tgt = ServerStAcquiring block point query m ()
-> m (ServerStAcquiring block point query m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerStAcquiring block point query m ()
 -> m (ServerStAcquiring block point query m ()))
-> ServerStAcquiring block point query m ()
-> m (ServerStAcquiring block point query m ())
forall a b. (a -> b) -> a -> b
$ case Target point -> Either AcquireFailure state
acquire Target point
tgt of
      Left AcquireFailure
failure -> AcquireFailure
-> ServerStIdle block point query m ()
-> ServerStAcquiring block point query m ()
forall block point (query :: * -> *) (m :: * -> *) a.
AcquireFailure
-> ServerStIdle block point query m a
-> ServerStAcquiring block point query m a
SendMsgFailure AcquireFailure
failure ServerStIdle block point query m ()
goIdle
      Right state
state  -> ServerStAcquired block point query m ()
-> ServerStAcquiring block point query m ()
forall block point (query :: * -> *) (m :: * -> *) a.
ServerStAcquired block point query m a
-> ServerStAcquiring block point query m a
SendMsgAcquired (ServerStAcquired block point query m ()
 -> ServerStAcquiring block point query m ())
-> ServerStAcquired block point query m ()
-> ServerStAcquiring block point query m ()
forall a b. (a -> b) -> a -> b
$ state -> ServerStAcquired block point query m ()
goAcquired state
state

    goAcquired :: state -> ServerStAcquired block point query m ()
    goAcquired :: state -> ServerStAcquired block point query m ()
goAcquired state
state = ServerStAcquired {
        recvMsgQuery :: forall result.
query result -> m (ServerStQuerying block point query m () result)
recvMsgQuery     = \query result
query ->
          ServerStQuerying block point query m () result
-> m (ServerStQuerying block point query m () result)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerStQuerying block point query m () result
 -> m (ServerStQuerying block point query m () result))
-> ServerStQuerying block point query m () result
-> m (ServerStQuerying block point query m () result)
forall a b. (a -> b) -> a -> b
$ result
-> ServerStAcquired block point query m ()
-> ServerStQuerying block point query m () result
forall result block point (query :: * -> *) (m :: * -> *) a.
result
-> ServerStAcquired block point query m a
-> ServerStQuerying block point query m a result
SendMsgResult (state -> query result -> result
forall result. state -> query result -> result
answer state
state query result
query) (ServerStAcquired block point query m ()
 -> ServerStQuerying block point query m () result)
-> ServerStAcquired block point query m ()
-> ServerStQuerying block point query m () result
forall a b. (a -> b) -> a -> b
$ state -> ServerStAcquired block point query m ()
goAcquired state
state
      , recvMsgReAcquire :: Target point -> m (ServerStAcquiring block point query m ())
recvMsgReAcquire = Target point -> m (ServerStAcquiring block point query m ())
goAcquiring
      , recvMsgRelease :: m (ServerStIdle block point query m ())
recvMsgRelease   = ServerStIdle block point query m ()
-> m (ServerStIdle block point query m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStIdle block point query m ()
goIdle
      }