Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Add LastGC newtype to store POSIXTime in standard format.
  • Loading branch information
paolino committed Mar 22, 2023
1 parent 888bdc8 commit 1948c43
Show file tree
Hide file tree
Showing 3 changed files with 31 additions and 8 deletions.
9 changes: 5 additions & 4 deletions lib/wallet/src/Cardano/Pool/DB/Sqlite.hs
Expand Up @@ -58,7 +58,7 @@ import Cardano.Pool.DB.Sqlite.TH hiding
import Cardano.Pool.Metadata.Types
( StakePoolMetadata (..), StakePoolMetadataHash )
import Cardano.Pool.Types
( PoolId (..) )
( LastGC (..), PoolId (..), lastGCTime )
import Cardano.Wallet.DB.Sqlite.Types
( BlockId (..), fromMaybeHash, toMaybeHash )
import Cardano.Wallet.Logging
Expand Down Expand Up @@ -562,8 +562,9 @@ newDBLayer tr ti SqliteContext{runQuery} =
[ InternalStateId ==. (InternalStateKey 1) ]
[ ]
case result of
Just _ -> update (InternalStateKey 1) [ LastGCMetadata =. Just utc ]
Nothing -> insert_ (InternalState $ Just utc)
Just _ -> update (InternalStateKey 1)
[ LastGCMetadata =. Just (LastGC utc) ]
Nothing -> insert_ (InternalState $ Just $ LastGC utc)

cleanDB = do
deleteWhere ([] :: [Filter PoolProduction])
Expand Down Expand Up @@ -984,4 +985,4 @@ toSettings :: W.Settings -> Settings
toSettings (W.Settings pms) = Settings pms

fromInternalState :: InternalState -> W.InternalState
fromInternalState (InternalState utc) = W.InternalState utc
fromInternalState (InternalState utc) = W.InternalState $ lastGCTime <$> utc
6 changes: 2 additions & 4 deletions lib/wallet/src/Cardano/Pool/DB/Sqlite/TH.hs
Expand Up @@ -27,7 +27,7 @@ import Prelude
import Cardano.Pool.Metadata.Types
( StakePoolMetadataHash (..), StakePoolMetadataUrl (..) )
import Cardano.Pool.Types
( PoolId (..), StakePoolTicker )
( LastGC, PoolId (..), StakePoolTicker )
import Cardano.Slotting.Slot
( SlotNo )
import Cardano.Wallet.DB.Sqlite.Types
Expand All @@ -38,8 +38,6 @@ import Data.Text
( Text )
import Data.Time.Clock
( UTCTime )
import Data.Time.Clock.POSIX
( POSIXTime )
import Data.Word
( Word32, Word64, Word8 )
import Database.Persist.TH
Expand All @@ -60,7 +58,7 @@ share
[persistLowerCase|

InternalState sql=internal_state
lastGCMetadata POSIXTime Maybe sql=last_gc_metadata
lastGCMetadata LastGC Maybe sql=last_gc_metadata

deriving Show Generic

Expand Down
24 changes: 24 additions & 0 deletions lib/wallet/src/Cardano/Pool/Types.hs
Expand Up @@ -14,6 +14,7 @@ module Cardano.Pool.Types
, decodePoolIdBech32
, encodePoolIdBech32
, StakePoolTicker (..)
, LastGC (..)
) where

import Prelude
Expand Down Expand Up @@ -46,6 +47,10 @@ import Data.Text.Class
( FromText (..), TextDecodingError (TextDecodingError), ToText (..) )
import Data.Text.Encoding
( decodeUtf8, encodeUtf8 )
import Data.Time.Clock.POSIX
( POSIXTime, posixSecondsToUTCTime, utcTimeToPOSIXSeconds )
import Data.Time.Format.ISO8601
( ISO8601 (iso8601Format), formatParseM, formatShow )
import Database.Persist.Class.PersistField
( PersistField (..) )
import Database.Persist.PersistValue.Extended
Expand Down Expand Up @@ -225,3 +230,22 @@ instance Buildable StakePoolsSummary where
, "Non-myopic member rewards: " <> mapF (Map.toList rewards)
, "Optimum number of pools: " <> pretty nOpt
]

newtype LastGC = LastGC {lastGCTime :: POSIXTime }
deriving (Show, Eq, Ord, Generic)

instance Buildable LastGC where
build (LastGC t) = build t

instance PersistField LastGC where
toPersistValue (LastGC t) = toPersistValue
$ formatShow iso8601Format $ posixSecondsToUTCTime t
fromPersistValue v = do
t <- fromPersistValue v
case formatParseM iso8601Format t of
Nothing -> Left "Invalid LastGC"
Just t' -> Right $ LastGC $ utcTimeToPOSIXSeconds t'

instance PersistFieldSql LastGC where
sqlType _ = sqlType (Proxy @Text)

0 comments on commit 1948c43

Please sign in to comment.