diff --git a/main/box.hs b/main/box.hs index 7c02036..3039832 100644 --- a/main/box.hs +++ b/main/box.hs @@ -317,13 +317,16 @@ exec cmd args = executeFile (T.unpack cmd) True (fmap T.unpack args) Nothing ------------------------------------------------------------------------ -- Environment Variables +-- Grab BOX_STORE from $ENV if defined and try to parse it: +-- 1. split on comma +-- 2. try to parse each element as an s3 Address, fall back to local file storeEnv :: IO BoxStore storeEnv = - -- Grab BOX_STORE from $ENV if defined, try to parse it as S3 - let envStore = lookupEnv "BOX_STORE" - tryS3 s = maybe (BoxStoreLocal s) - BoxStoreS3 . Mismi.addressFromText $ T.pack s - in fmap (maybe defaultBoxStore tryS3) envStore + with (lookupEnv "BOX_STORE") $ \envStore -> + maybe defaultBoxStore (BoxStore . fmap tryS3 . T.splitOn "," . T.pack) envStore + where + tryS3 s = maybe (BoxFileLocal $ T.unpack s) + BoxFileS3 $ Mismi.addressFromText s userEnv :: IO Text userEnv = diff --git a/src/Box/Data.hs b/src/Box/Data.hs index 0ce4628..8a8c892 100644 --- a/src/Box/Data.hs +++ b/src/Box/Data.hs @@ -6,6 +6,7 @@ module Box.Data ( Box (..) , BoxStore (..) + , BoxFile (..) , Query (..) , Exact (..) , Infix (..) @@ -74,9 +75,13 @@ data Box = , boxNote :: Note } deriving (Eq, Ord, Show) -data BoxStore = - BoxStoreLocal FilePath - | BoxStoreS3 Address +data BoxStore = BoxStore { + unBoxFiles :: [BoxFile] + } deriving (Eq, Show) + +data BoxFile = + BoxFileLocal FilePath + | BoxFileS3 Address deriving (Eq, Show) data Query = Query { @@ -162,7 +167,7 @@ newtype Note = } deriving (Eq, Ord, Show) data BoxError = - BoxNotFound BoxStore + BoxFileNotFound BoxFile | BoxParseError Text deriving (Eq, Show) @@ -320,15 +325,15 @@ boxParser = do endOfInput pure $ Box c f n i h p ctx is tz im az lc hk pr nt -boxStoreRender :: BoxStore -> Text -boxStoreRender (BoxStoreLocal f) = +boxFileRender :: BoxFile -> Text +boxFileRender (BoxFileLocal f) = T.pack f -boxStoreRender (BoxStoreS3 a) = +boxFileRender (BoxFileS3 a) = addressToText a boxErrorRender :: BoxError -> Text -boxErrorRender (BoxNotFound bs) = - "Could not find the box file located at: " <> boxStoreRender bs +boxErrorRender (BoxFileNotFound bs) = + "Could not find the box file located at: " <> boxFileRender bs boxErrorRender (BoxParseError e) = "Error parsing box file with the following error: " <> e diff --git a/src/Box/Store.hs b/src/Box/Store.hs index 87ef81e..74bf340 100644 --- a/src/Box/Store.hs +++ b/src/Box/Store.hs @@ -31,41 +31,58 @@ import X.Control.Monad.Trans.Either (pattern EitherT, runEitherT, hois readBoxes :: BoxStore -> Environment -> AWS (Either BoxError [Box]) -readBoxes bxs env = case boxStoreWithEnv bxs env of - bs@(BoxStoreLocal fp) -> liftIO . runEitherT $ do - t <- EitherT $ ifM (doesFileExist fp) (fmap Right $ T.readFile fp) (pure . Left $ BoxNotFound bs) - hoistEither . first BoxParseError $ boxesFromText t - bs@(BoxStoreS3 a) -> - (=<<) (first BoxParseError . boxesFromText) . maybeToRight (BoxNotFound bs) <$> Mismi.read a +readBoxes bs env = + with (mapM readBoxFile . unBoxFiles $ boxStoreWithEnv env bs) $ \xs -> + fmap join $ sequence xs -writeBoxes :: [Box] -> BoxStore -> Environment -> AWS () -writeBoxes bs bxs env = case boxStoreWithEnv bxs env of - BoxStoreLocal lf -> liftIO $ +readBoxFile :: BoxFile -> AWS (Either BoxError [Box]) +readBoxFile bf = + case bf of + BoxFileLocal fp -> + liftIO . runEitherT $ do + t <- EitherT $ ifM (doesFileExist fp) (fmap Right $ T.readFile fp) (pure . Left $ BoxFileNotFound bf) + hoistEither . first BoxParseError $ boxesFromText t + BoxFileS3 a -> + (=<<) (first BoxParseError . boxesFromText) . maybeToRight (BoxFileNotFound bf) <$> Mismi.read a + +writeBoxes :: [Box] -> BoxFile -> Environment -> AWS () +writeBoxes bs bf env = case boxFileWithEnv env bf of + BoxFileLocal lf -> liftIO $ ifM (doesFileExist lf) (fail $ "File already exists " <> lf) (T.writeFile lf . boxesToText $ bs) - BoxStoreS3 a -> + BoxFileS3 a -> void . Mismi.writeWithMode Fail a . boxesToText $ bs listEnvironments :: BoxStore -> AWS [Text] -listEnvironments bs = envNames bs +listEnvironments (BoxStore bfs) = + fmap join $ mapM envNames bfs where - envNames (BoxStoreLocal fp) = do + envNames (BoxFileLocal fp) = do paths <- liftIO $ getDirectoryContents (takeDirectory fp) return [ noSuffix p | p <- paths, validEnv p ] - envNames (BoxStoreS3 (Address b k)) = do + envNames (BoxFileS3 (Address b k)) = do paths <- Mismi.list (Address b (Mismi.dirname k)) return [ noSuffix x | p <- paths, let x = unpackKey p, validEnv x] noSuffix = T.pack . dropExtension . takeFileName - validEnv = (== ".v2") . takeExtension + validEnv = (== ".v3") . takeExtension unpackKey (Address _ (Key k)) = T.unpack k defaultBoxStore :: BoxStore defaultBoxStore = - BoxStoreS3 (Address (Bucket "ambiata-dispensary") (Key "box/prod.v3")) + BoxStore [ + BoxFileS3 $ Address (Bucket "ambiata-dispensary") (Key "box/prod.v3") + ] -- Filepath munging for alt environments -boxStoreWithEnv :: BoxStore -> Environment -> BoxStore -boxStoreWithEnv bs DefaultEnv = bs -boxStoreWithEnv (BoxStoreS3 (Address b (Key k))) (SomeEnv e) = - BoxStoreS3 (Address b (Key . T.pack $ dropFileName (T.unpack k) T.unpack e <.> ".v3")) -boxStoreWithEnv (BoxStoreLocal lf) (SomeEnv e) = - BoxStoreLocal (dropFileName lf T.unpack e <.> ".v3") +boxStoreWithEnv :: Environment -> BoxStore -> BoxStore +boxStoreWithEnv e (BoxStore bfs) = + BoxStore $ fmap (boxFileWithEnv e) bfs + +boxFileWithEnv :: Environment -> BoxFile -> BoxFile +boxFileWithEnv env bf = + case (env, bf) of + (DefaultEnv, _) -> + bf + (SomeEnv e, BoxFileS3 (Address b (Key k))) -> + BoxFileS3 $ Address b (Key . T.pack $ dropFileName (T.unpack k) T.unpack e <.> ".v3") + (SomeEnv e, BoxFileLocal lf) -> + BoxFileLocal $ dropFileName lf T.unpack e <.> ".v3" diff --git a/test/Test/IO/Box/Store.hs b/test/Test/IO/Box/Store.hs index d5fe78d..c3053f6 100644 --- a/test/Test/IO/Box/Store.hs +++ b/test/Test/IO/Box/Store.hs @@ -7,8 +7,6 @@ module Test.IO.Box.Store where import Box.Data import Box.Store -import Mismi (AWS) - import P import Test.Box.Arbitrary () @@ -16,21 +14,24 @@ import Test.Mismi.S3 (testAWS, newFilePath, newAddress) import Test.QuickCheck -prop_readwrite_s3 bs = testAWS $ do +prop_readwrite_s3 bs bs' = testAWS $ do path <- newAddress - writeReadBoxes bs . BoxStoreS3 $ path + path' <- newAddress + writeBoxes bs (BoxFileS3 path) DefaultEnv + writeBoxes bs' (BoxFileS3 path') DefaultEnv + bxs <- readBoxes (BoxStore [BoxFileS3 path, BoxFileS3 path']) DefaultEnv + pure $ bxs === Right (bs <> bs') -prop_readwrite_local bs = testAWS $ do +prop_readwrite_local bs bs' = testAWS $ do path <- newFilePath - writeReadBoxes bs . BoxStoreLocal . (<> "/file") $ path - - -writeReadBoxes :: [Box] -> BoxStore -> AWS Property -writeReadBoxes bs f = do - writeBoxes bs f DefaultEnv - bs' <- readBoxes f DefaultEnv - pure $ bs' === Right bs - + path' <- newFilePath + let + lf = BoxFileLocal . (<> "/file") $ path + lf' = BoxFileLocal . (<> "/file") $ path' + writeBoxes bs lf DefaultEnv + writeBoxes bs' lf' DefaultEnv + bxs <- readBoxes (BoxStore [lf, lf']) DefaultEnv + pure $ bxs === Right (bs <> bs') return [] tests = $forAllProperties $ quickCheckWithResult (stdArgs { maxSuccess = 10 })