1{-# LANGUAGE TemplateHaskell #-} 2module Matterhorn.LastRunState 3 ( LastRunState 4 , lrsHost 5 , lrsPort 6 , lrsUserId 7 , lrsSelectedChannelId 8 , writeLastRunStates 9 , readLastRunState 10 , isValidLastRunState 11 ) 12where 13 14import Prelude () 15import Matterhorn.Prelude 16 17import Control.Monad.Trans.Except 18import qualified Data.Aeson as A 19import qualified Data.ByteString as BS 20import qualified Data.ByteString.Lazy as LBS 21import qualified Data.HashMap.Strict as HM 22import Lens.Micro.Platform ( makeLenses ) 23import System.Directory ( createDirectoryIfMissing ) 24import System.FilePath ( dropFileName ) 25import qualified System.Posix.Files as P 26import qualified System.Posix.Types as P 27 28import Network.Mattermost.Lenses 29import Network.Mattermost.Types 30 31import Matterhorn.FilePaths 32import Matterhorn.IOUtil 33import Matterhorn.Types 34 35 36-- | Run state of the program. This is saved in a file on program exit and 37-- | looked up from the file on program startup. 38data LastRunState = LastRunState 39 { _lrsHost :: Hostname -- ^ Host of the server 40 , _lrsPort :: Port -- ^ Post of the server 41 , _lrsUserId :: UserId -- ^ ID of the logged-in user 42 , _lrsSelectedChannelId :: ChannelId -- ^ ID of the last selected channel 43 } 44 45instance A.ToJSON LastRunState where 46 toJSON lrs = A.object [ "host" A..= _lrsHost lrs 47 , "port" A..= _lrsPort lrs 48 , "user_id" A..= _lrsUserId lrs 49 , "sel_channel_id" A..= _lrsSelectedChannelId lrs 50 ] 51 52instance A.FromJSON LastRunState where 53 parseJSON = A.withObject "LastRunState" $ \v -> 54 LastRunState 55 <$> v A..: "host" 56 <*> v A..: "port" 57 <*> v A..: "user_id" 58 <*> v A..: "sel_channel_id" 59 60makeLenses ''LastRunState 61 62toLastRunState :: ChatState -> LastRunState 63toLastRunState cs = LastRunState 64 { _lrsHost = cs^.csResources.crConn.cdHostnameL 65 , _lrsPort = cs^.csResources.crConn.cdPortL 66 , _lrsUserId = myUserId cs 67 , _lrsSelectedChannelId = cs^.csCurrentChannelId(cs^.csCurrentTeamId) 68 } 69 70lastRunStateFileMode :: P.FileMode 71lastRunStateFileMode = P.unionFileModes P.ownerReadMode P.ownerWriteMode 72 73-- | Writes the run state to a file. The file is specific to the current team. 74-- | Writes only if the current channel is an ordrinary or a private channel. 75writeLastRunStates :: ChatState -> IO () 76writeLastRunStates cs = 77 forM_ (HM.keys $ cs^.csTeams) $ \tId -> 78 writeLastRunState cs tId 79 80writeLastRunState :: ChatState -> TeamId -> IO () 81writeLastRunState cs tId = do 82 when (cs^.csCurrentChannel.ccInfo.cdType `elem` [Ordinary, Private]) $ do 83 let runState = toLastRunState cs 84 85 lastRunStateFile <- lastRunStateFilePath $ unId $ toId tId 86 createDirectoryIfMissing True $ dropFileName lastRunStateFile 87 BS.writeFile lastRunStateFile $ LBS.toStrict $ A.encode runState 88 P.setFileMode lastRunStateFile lastRunStateFileMode 89 90-- | Reads the last run state from a file given the current team ID. 91readLastRunState :: TeamId -> IO (Either String LastRunState) 92readLastRunState tId = runExceptT $ do 93 contents <- convertIOException $ 94 lastRunStateFilePath (unId $ toId tId) >>= BS.readFile 95 case A.eitherDecodeStrict' contents of 96 Right val -> return val 97 Left err -> throwE $ "Failed to parse lastRunState file: " ++ err 98 99-- | Checks if the given last run state is valid for the current server and user. 100isValidLastRunState :: ChatResources -> User -> LastRunState -> Bool 101isValidLastRunState cr me rs = 102 rs^.lrsHost == cr^.crConn.cdHostnameL 103 && rs^.lrsPort == cr^.crConn.cdPortL 104 && rs^.lrsUserId == me^.userIdL 105