git.iko.soy/typeable/katip
on master help sign in
Add weekly sharding option
commita8f098b0a4db567beed874c7d4c54793fd8a2cef authorMichael Xavier <michael@michaelxavier.net> dateTue 1 Mar 2016, 14:36 (11 years ago) parent846b630
2 files changed+54
compare with master
unifiedsplit
katip-elasticsearch/src/Katip/Scribes/ElasticSearch.hs+20 katip-elasticsearch/test/Main.hs+34
katip-elasticsearch/src/Katip/Scribes/ElasticSearch.hs+20
@@ -26,6 +26,7 @@ module Katip.Scribes.ElasticSearch
2626 -- * Utilities
2727 , mkDocId
2828 , module Katip.Scribes.ElasticSearch.Annotations
29+ , roundToSunday
2930 ) where
3031
3132
@@ -50,6 +51,7 @@ import Data.Text (Text)
5051import qualified Data.Text as T
5152import qualified Data.Text.Encoding as T
5253import Data.Time
54+import Data.Time.Calendar.WeekDate
5355import Data.Typeable
5456import Data.UUID
5557import Database.Bloodhound
@@ -147,6 +149,8 @@ defaultEsScribeCfg = EsScribeCfg {
147149-- (e.g. @foo-2016-*@).
148150data IndexShardingPolicy = NoIndexSharding
149151 | MonthlyIndexSharding
152+ | WeeklyIndexSharding
153+ -- ^ A special case of daily which shards to sunday
150154 | DailyIndexSharding
151155 | HourlyIndexSharding
152156 | EveryMinuteIndexSharding
@@ -156,6 +160,7 @@ data IndexShardingPolicy = NoIndexSharding
156160instance Show IndexShardingPolicy where
157161 show NoIndexSharding = "NoIndexSharding"
158162 show MonthlyIndexSharding = "MonthlyIndexSharding"
163+ show WeeklyIndexSharding = "WeeklyIndexSharding"
159164 show DailyIndexSharding = "DailyIndexSharding"
160165 show HourlyIndexSharding = "HourlyIndexSharding"
161166 show EveryMinuteIndexSharding = "EveryMinuteIndexSharding"
@@ -174,6 +179,9 @@ shardPolicySegs NoIndexSharding _ = []
174179shardPolicySegs MonthlyIndexSharding Item {..} = [sis y, sis m]
175180 where
176181 (y, m, _) = toGregorian (utctDay _itemTime)
182+shardPolicySegs WeeklyIndexSharding Item {..} = [sis y, sis m, sis d]
183+ where
184+ (y, m, d) = toGregorian (roundToSunday (utctDay _itemTime))
177185shardPolicySegs DailyIndexSharding Item {..} = [sis y, sis m, sis d]
178186 where
179187 (y, m, d) = toGregorian (utctDay _itemTime)
@@ -188,6 +196,18 @@ shardPolicySegs EveryMinuteIndexSharding Item {..} = [sis y, sis m, sis d, sis h
188196shardPolicySegs (CustomIndexSharding f) i = f i
189197
190198
199+-------------------------------------------------------------------------------
200+-- | If the given day is sunday, returns the input, otherwise returns
201+-- the previous sunday
202+roundToSunday :: Day -> Day
203+roundToSunday d
204+ | dow == 7 = d
205+ | w > 1 = fromWeekDate y (w - 1) 7
206+ | otherwise = fromWeekDate (y - 1) 53 7
207+ where
208+ (y, w, dow) = toWeekDate d
209+
210+
191211-------------------------------------------------------------------------------
192212chooseIxn :: IndexName -> IndexShardingPolicy -> Item a -> IndexName
193213chooseIxn (IndexName ixn) p i =
katip-elasticsearch/test/Main.hs+34
@@ -22,6 +22,7 @@ import qualified Data.Map as M
2222import Data.Monoid
2323import Data.Scientific
2424import Data.Time
25+import Data.Time.Calendar.WeekDate
2526import qualified Data.Vector as V
2627import Database.Bloodhound hiding (key)
2728import Network.HTTP.Client
@@ -41,6 +42,7 @@ main = defaultMain $ testGroup "katip-elasticsearch"
4142 [
4243 esTests
4344 , typeAnnotatedTests
45+ , roundToSundayTests
4446 ]
4547
4648
@@ -105,6 +107,24 @@ esTests = testGroup "elasticsearch scribe"
105107 let logTomorrow = head tomorrowLogs
106108 logToday ^? key "_source" . key "msg" . _String @?= Just "today"
107109 logTomorrow ^? key "_source" . key "msg" . _String @?= Just "tomorrow"
110+ , withSearch' (\c -> c { essIndexSharding = WeeklyIndexSharding}) $ \setup -> testCase "weekly index sharding rounds to previous sunday" $ do
111+ let t1 = mkTime 2016 3 5 0 0 0 -- saturday, march 5th
112+ fakeClock <- newTVarIO t1
113+ withTestLogging' (set logEnvTimer (readTVarIO fakeClock)) setup $ \done -> do
114+ $(logT) (ExampleCtx True) mempty InfoS "today"
115+ let t2 = mkTime 2016 3 6 0 0 0 -- sunday march 6th
116+ liftIO (atomically (writeTVar fakeClock t2))
117+ $(logT) (ExampleCtx True) mempty InfoS "tomorrow"
118+ liftIO $ do
119+ void done
120+ todayLogs <- getLogsByIndex (IndexName "katip-elasticsearch-tests-2016-2-28") -- rounds back to previous sunday
121+ tomorrowLogs <- getLogsByIndex (IndexName "katip-elasticsearch-tests-2016-3-6") -- is on sunday, so uses current date
122+ assertBool ("todayLogs has " <> show (length todayLogs) <> " items") (length todayLogs == 1)
123+ assertBool ("tomorrowLogs has " <> show (length tomorrowLogs) <> " items") (length tomorrowLogs == 1)
124+ let logToday = head todayLogs
125+ let logTomorrow = head tomorrowLogs
126+ logToday ^? key "_source" . key "msg" . _String @?= Just "today"
127+ logTomorrow ^? key "_source" . key "msg" . _String @?= Just "tomorrow"
108128 ]
109129
110130
@@ -152,6 +172,20 @@ typeAnnotatedTests = testGroup "TypeAnnotated"
152172 ]
153173
154174
175+-------------------------------------------------------------------------------
176+roundToSundayTests :: TestTree
177+roundToSundayTests = testGroup "roundToSunday"
178+ [
179+ testProperty "always returns a sunday" $ \d ->
180+ getDOW (roundToSunday d) === 7
181+ , testProperty "returns input on sunday" $ \d -> getDOW d == 7 ==>
182+ roundToSunday d === d
183+ , testProperty "goes back a week when not sunday" $ \d -> getDOW d /= 7 ==>
184+ roundToSunday d < d
185+ ]
186+ where
187+ getDOW = view _3 . toWeekDate
188+
155189-------------------------------------------------------------------------------
156190exampleValue :: Value
157191exampleValue = Array $ V.fromList [Null, Object ob]