@@ -11,8 +11,16 @@ module BotPlutusInterface.TimeSlot (
11
11
posixTimeRangeToContainedSlotRangeIO ,
12
12
) where
13
13
14
- import BotPlutusInterface.QueryNode (NodeInfo (NodeInfo ), queryEraHistory , querySystemStart )
15
- import BotPlutusInterface.Types (PABConfig , pcNetwork , pcProtocolParams )
14
+ import BotPlutusInterface.QueryNode (
15
+ NodeInfo (NodeInfo ),
16
+ queryEraHistory ,
17
+ querySystemStart ,
18
+ )
19
+ import BotPlutusInterface.Types (
20
+ PABConfig ,
21
+ pcNetwork ,
22
+ pcProtocolParams ,
23
+ )
16
24
import Cardano.Api (CardanoMode , EraHistory )
17
25
import Cardano.Api qualified as CAPI
18
26
import Cardano.Ledger.Alonzo.PParams (_protocolVersion )
@@ -22,13 +30,24 @@ import Cardano.Slotting.EpochInfo (hoistEpochInfo)
22
30
import Cardano.Slotting.Time (SystemStart , toRelativeTime )
23
31
import Control.Monad.Except (runExcept )
24
32
import Control.Monad.IO.Class (liftIO )
25
- import Control.Monad.Trans.Either (EitherT , firstEitherT , hoistEither , newEitherT , runEitherT )
33
+ import Control.Monad.Trans.Either (
34
+ EitherT ,
35
+ firstEitherT ,
36
+ hoistEither ,
37
+ newEitherT ,
38
+ runEitherT ,
39
+ )
26
40
import Data.Bifunctor (first )
27
41
import Data.Text (Text )
28
42
import Data.Text qualified as Text
29
- import Data.Time (secondsToNominalDiffTime )
43
+ import Data.Time (UTCTime , secondsToNominalDiffTime )
30
44
import Data.Time.Clock.POSIX (posixSecondsToUTCTime )
31
- import Ledger (Extended (Finite , NegInf , PosInf ), Interval (Interval ), LowerBound (LowerBound ), UpperBound (UpperBound ))
45
+ import Ledger (
46
+ Extended (Finite , NegInf , PosInf ),
47
+ Interval (Interval ),
48
+ LowerBound (LowerBound ),
49
+ UpperBound (UpperBound ),
50
+ )
32
51
import Ledger qualified
33
52
import Ouroboros.Consensus.HardFork.History qualified as Consensus
34
53
import Ouroboros.Consensus.HardFork.History.Qry qualified as HF
@@ -86,7 +105,7 @@ posixTimeRangeToContainedSlotRangeIO
86
105
-- getting required info from node
87
106
nodeInfo <- liftIO $ mkNodeInfo pabConf
88
107
sysStart <- newET $ querySystemStart nodeInfo
89
- eraHsitory <- newET ( queryEraHistory nodeInfo)
108
+ eraHsitory <- newET $ queryEraHistory nodeInfo
90
109
let epochInfo = toLedgerEpochInfo eraHsitory
91
110
pparams =
92
111
CAPI. toLedgerPParams
@@ -101,9 +120,16 @@ posixTimeRangeToContainedSlotRangeIO
101
120
startSlotClosure <- getClosure startSlot startIncl
102
121
endSlot <- extTimeToExtSlot end
103
122
endSlotClosure <- getClosure endSlot endIncl
104
- let lowerB = LowerBound startSlot startSlotClosure
123
+ let lowerB :: LowerBound Ledger. Slot
124
+ lowerB = LowerBound startSlot startSlotClosure
125
+
126
+ upperB :: UpperBound Ledger. Slot
105
127
upperB = UpperBound endSlot endSlotClosure
106
- pure $ Interval lowerB upperB
128
+
129
+ range :: Ledger. SlotRange
130
+ range = Interval lowerB upperB
131
+
132
+ pure range
107
133
where
108
134
convertExtended sysStart eraHist =
109
135
firstEitherT toError . hoistEither . \ case
@@ -128,13 +154,16 @@ posixTimeToSlot ::
128
154
EraHistory CardanoMode ->
129
155
Ledger. POSIXTime ->
130
156
Either HF. PastHorizonException Ledger. Slot
131
- posixTimeToSlot sysStart eraHist pTime =
157
+ posixTimeToSlot sysStart eraHist pTime = do
132
158
-- toRelativeTime checks that pTime >= sysStart via `Control.Exception.assert`
133
159
let relativeTime = toRelativeTime sysStart (toUtc pTime)
134
160
(CAPI. EraHistory _ int) = eraHist
135
- in HF. interpretQuery int (HF. wallclockToSlot relativeTime)
136
- >>= \ (s, _, _) -> return (fromSlotNo s)
161
+ query = HF. wallclockToSlot relativeTime
162
+
163
+ (sn, _, _) <- HF. interpretQuery int query
164
+ return (fromSlotNo sn)
137
165
where
166
+ toUtc :: Ledger. POSIXTime -> UTCTime
138
167
toUtc (Ledger. POSIXTime milliseconds) =
139
168
posixSecondsToUTCTime
140
169
. secondsToNominalDiffTime
0 commit comments