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