Multi box file support

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 =

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
 

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"

test/Test/IO/Box/Store.hs

@@ -7,30 +7,31 @@ module Test.IO.Box.Store where
 import           Box.Data
 import           Box.Store
 
-import           Mismi (AWS)
-
 import           P
 
 import           Test.Box.Arbitrary ()
 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 })