{-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} module Gamgee.Test.Effects ( runOutputPure , runListSecretInput , runCryptoRandom , runByteStoreST ) where import Control.Monad.ST (ST) import qualified Crypto.Random as CR import qualified Crypto.Random.Types as CRT import Data.STRef (STRef) import qualified Data.STRef as STRef import qualified Gamgee.Effects as Eff import Polysemy (Lift, Member, Sem) import qualified Polysemy as P import qualified Polysemy.Output as P import qualified Polysemy.State as P import Relude ---------------------------------------------------------------------------------------------------- -- Interpret Output by accumulating it in a list ---------------------------------------------------------------------------------------------------- runOutputPure :: Sem (P.Output o : r) a -> Sem r ([o], a) runOutputPure = P.runFoldMapOutput one ---------------------------------------------------------------------------------------------------- -- Interpret SecretInput by reading from a list ---------------------------------------------------------------------------------------------------- runListSecretInput :: [i] -> Sem (Eff.SecretInput i : r) a -> Sem r a runListSecretInput is = fmap snd . P.runState is . P.reinterpret (\case Eff.SecretInput _ -> do s <- P.gets uncons whenJust s (P.put . snd) maybe (error "Ran out of input in SecretInput") return (fst <$> s) ) ---------------------------------------------------------------------------------------------------- -- Interpret CryptoRandom with a DRG ---------------------------------------------------------------------------------------------------- runCryptoRandom :: CR.DRG gen => gen -> Sem (Eff.CryptoRandom : r) a -> Sem r a runCryptoRandom gen = P.interpret $ \case Eff.RandomBytes count -> return (fst $ CR.withDRG gen (CRT.getRandomBytes count)) ---------------------------------------------------------------------------------------------------- -- Interpret ByteStore using the ST monad ---------------------------------------------------------------------------------------------------- runByteStoreST :: Member (Lift (ST s)) r => STRef s (Maybe LByteString) -> Sem (Eff.ByteStore : r) a -> Sem r a runByteStoreST ref = P.interpret $ \case Eff.ReadByteStore -> P.sendM $ STRef.readSTRef ref Eff.WriteByteStore bytes -> P.sendM $ STRef.writeSTRef ref (Just bytes)