{- Copyright 2016 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

module Storage (module Storage, module Types.Storage) where

import Types
import Types.Storage
import Share
import Storage.Local
import Storage.Network
import Data.Monoid
import Data.Maybe
import System.FilePath
import Control.Monad

allStorageLocations :: IO StorageLocations
allStorageLocations = do
	servers <- networkServers
	return $ StorageLocations $
		map networkStorage servers <> map uploadQueue servers

localStorageLocations :: StorageLocations
localStorageLocations = StorageLocations $
	map (localStorage . ("local" </>) . show)
		[1..100 :: Int]

type UpdateProgress = IO ()

-- | Stores the shares amoung the storage locations. Each location
-- gets at most one share.
storeShares :: StorageLocations -> ShareIdents -> [(UpdateProgress, Share)] -> IO StoreResult
storeShares (StorageLocations locs) sis shares = do
	(r, usedlocs) <- go locs [] Nothing (zip (getIdents sis) shares)
	_ <- mapM_ obscureShares usedlocs
	return r
  where
	go _ usedlocs _ [] = return (StoreSuccess, usedlocs)
	go [] usedlocs lasterr _ =
		return (fromMaybe (StoreFailure "no storage locations") lasterr, usedlocs)
	go (loc:otherlocs) usedlocs _ tostore@((i,(showprogress, s)):rest) = do
		r <- storeShare loc i s
		case r of
			StoreSuccess -> do
				_ <- showprogress
				go otherlocs (loc:usedlocs) Nothing rest
			StoreFailure _ -> go otherlocs usedlocs (Just r) tostore
			-- Give up if any location complains a share
			-- already exists, because we have a name conflict.
			StoreAlreadyExists -> return (StoreAlreadyExists, usedlocs)

-- | Retrieves shares from among the storage locations, and returns all
-- the shares it can find, which may not be all that were requested.
--
-- Assumes that each location only contains one share. So, once a
-- share has been found on a location, can avoid asking that location
-- for any other shares.
retrieveShares :: StorageLocations -> [(UpdateProgress, (ShareNum, StorableObjectIdent))] -> IO [Share]
retrieveShares (StorageLocations locs) l = do
	(shares, usedlocs, _unusedlocs) <- go locs [] l []
	_ <- mapM_ obscureShares usedlocs
	return shares
  where
	go unusedlocs usedlocs [] shares = return (shares, usedlocs, unusedlocs)
	go [] usedlocs _ shares = return (shares, usedlocs, [])
	go (loc:otherlocs) usedlocs (toretrieve@(updateprogress, (n, i)):rest) shares = do
		r <- retrieveShare loc n i
		case r of
			RetrieveSuccess s -> do
				_ <- updateprogress
				go otherlocs (loc:usedlocs) rest (s:shares)
			RetrieveFailure _ -> do
				(shares', usedlocs', unusedlocs) <-
					go otherlocs usedlocs [toretrieve] shares
				-- May need to ask the location that didn't
				-- have the share for a later share, but
				-- ask it last. This way, the first
				-- location on the list can't deny having
				-- all shares and so learn the idents of
				-- all of them.
				go (unusedlocs++[loc]) usedlocs' rest shares'

uploadQueued :: IO ()
uploadQueued = do
	servers <- networkServers
	forM_ servers $ \s -> moveShares (uploadQueue s) (networkStorage s)