Spec.hs

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TemplateHaskell       #-}


import           Prelude                      hiding (writeFile)

import           Control.Monad                (MonadPlus (..))
import           Control.Monad.TestFixture
import           Control.Monad.TestFixture.TH
import           Control.Monad.Trans.Class    (lift)
import           Data.ByteString              (ByteString)
import           Test.Hspec
import           Control.Monad.Trans.Maybe    (MaybeT)
import           Control.Monad.Trans.Maybe    (runMaybeT)

type Credentials = ()


class (Monad m) => MonadWriteFS m where
    writeFile :: FilePath -> ByteString -> m ()

class (Monad m) => MonadReadFS m where
    decryptSavedCredentials :: FilePath -> ByteString -> m Credentials

instance (MonadReadFS m) => MonadReadFS (MaybeT m) where
    decryptSavedCredentials fp = lift . decryptSavedCredentials fp

instance (MonadWriteFS m) => MonadWriteFS (MaybeT m) where
    writeFile path = lift . writeFile path


mkFixture "FixtureInst2" [
      ''MonadWriteFS
    , ''MonadReadFS
    ]

program :: (MonadWriteFS m, MonadReadFS (MaybeT m)) => m Credentials
program = do
    credentials <- runMaybeT $ decryptSavedCredentials undefined undefined
    let x = maybe "0" (const "1") credentials
    writeFile "credentials.enc" x

fakeDecryptCredentials :: (MonadPlus m, MonadState [Event] m) => m Credentials
fakeDecryptCredentials = do
    saved <- gets $ elem $ Write "credentials.enc"
    if saved
        then pure ()
        else mzero


data Event = Authorize | Refresh | Write FilePath deriving (Eq, Show)

logEvent :: MonadState [Event] m => Event -> m ()
logEvent e = modify (e:)

main :: IO ()
main = hspec $
    describe "foo" $
        it "bar" $ do
            let inst = def {
                  _writeFile = const . logEvent . Write
                , _decryptSavedCredentials = \_ _ -> fakeDecryptCredentials
            }
            let mCalls = do
                    (calls, _) <- execTestFixtureT (program >> program) inst []
                    pure $ reverse calls
            mCalls `shouldBe` Just [Write "credentials.enc", Write "credentials.enc"]