module Gamgee.Effects.JSONStore
(
JSONStore (..)
, jsonEncode
, jsonDecode
, runJSONStore
, configStoreToByteStore
) where
import qualified Data.Aeson as Aeson
import qualified Gamgee.Effects.ByteStore as BS
import qualified Gamgee.Effects.Error as Err
import qualified Gamgee.Token as Token
import Polysemy (Member, Sem)
import qualified Polysemy as P
import qualified Polysemy.Error as P
import Relude
data JSONStore o m a where
JsonEncode :: o -> JSONStore o m ()
JsonDecode :: JSONStore o m o
P.makeSem ''JSONStore
runJSONStore :: Member (P.Error Err.EffError) r
=> Sem (JSONStore Token.Tokens : r) a
-> Sem (BS.ByteStore : r) a
runJSONStore = configStoreToByteStore . tokenStoreToConfigStore
tokenStoreToConfigStore :: Member (P.Error Err.EffError) r
=> Sem (JSONStore Token.Tokens : r) a
-> Sem (JSONStore Token.Config : r) a
tokenStoreToConfigStore =
P.reinterpret $ \case
JsonEncode o -> tokensToConfig o >>= jsonEncode
JsonDecode -> jsonDecode >>= configToTokens
where
tokensToConfig :: Token.Tokens -> Sem r Token.Config
tokensToConfig ts = return $ Token.Config { Token.configVersion = Token.currentConfigVersion, Token.configTokens = ts }
configToTokens :: Member (P.Error Err.EffError) r => Token.Config -> Sem r Token.Tokens
configToTokens cfg = if Token.configVersion cfg == Token.currentConfigVersion
then return (Token.configTokens cfg)
else P.throw $ Err.UnsupportedConfigVersion $ Token.configVersion cfg
configStoreToByteStore :: Member (P.Error Err.EffError) r
=> Sem (JSONStore Token.Config : r) a
-> Sem (BS.ByteStore : r) a
configStoreToByteStore =
P.reinterpret $ \case
JsonEncode cfg -> BS.writeByteStore $ Aeson.encode cfg
JsonDecode -> do
bytes <- BS.readByteStore
let
cfg = maybe (Right Token.initialConfig) Aeson.eitherDecode' bytes
either handleDecodeError return cfg
where
handleDecodeError :: Member (P.Error Err.EffError) r => String -> Sem r a
handleDecodeError msg = P.throw $ Err.JSONDecodeError $ toText msg