module Boots.Factory.Application(
HasApp(..)
, AppEnv(..)
, buildApp
, rand64
, buildRandom
) where
import Boots.Factory
import Boots.Factory.Logger
import Boots.Factory.Salak
import Control.Concurrent.MVar
import Data.Maybe
import Data.String (fromString)
import Data.Text (Text)
import Data.Version (Version)
import Data.Word
import Lens.Micro
import Lens.Micro.Extras
import Numeric (showHex)
import Salak
import System.Random.SplitMix
class HasApp env where
askApp :: Lens' env AppEnv
instance HasApp AppEnv where
askApp = id
instance HasSalak AppEnv where
askSourcePack = lens configure (\x y -> x {configure = y})
instance HasLogger AppEnv where
askLogger = lens logF (\x y -> x {logF = y})
data AppEnv = AppEnv
{ name :: Text
, instanceId :: Text
, version :: Version
, tags :: [Text]
, randSeed :: MVar SMGen
, configure :: Salak
, logF :: LogFunc
}
buildApp :: (MonadIO m, MonadCatch m) => String -> Version -> Factory m () AppEnv
buildApp confName version = do
configure <- buildSalak confName
within configure $ do
name <- fromMaybe (fromString confName) <$> require "application.name"
logF <- buildLogger name
tags <- require "application.tags"
randSeed <- offer $ liftIO $ initSMGen >>= newMVar
instanceId <- offer $ liftIO $ hex64 <$> random64 randSeed
return AppEnv{..}
random64 :: MVar SMGen -> IO Word64
random64 ref = modifyMVar ref (return . go . nextWord64)
where
go (a,b) = (b,a)
hex64 :: Word64 -> Text
hex64 i = fromString $ let x = showHex i "" in replicate (16 - length x) '0' ++ x
rand64 :: MonadIO m => MVar SMGen -> m Text
rand64 = liftIO . fmap hex64 . random64
buildRandom :: (MonadIO m, HasApp env) => Factory m env Text
buildRandom = do
AppEnv{..} <- asks (view askApp)
offer $ rand64 randSeed