{-# LANGUAGE TemplateHaskell #-}
module Matterhorn.LastRunState
  ( LastRunState
  , lrsHost
  , lrsPort
  , lrsUserId
  , lrsSelectedChannelId
  , lrsOpenThread
  , writeLastRunStates
  , readLastRunState
  , isValidLastRunState
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Control.Monad.Trans.Except
import qualified Data.Aeson as A
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as HM
import           Lens.Micro.Platform ( makeLenses )
import           System.Directory ( createDirectoryIfMissing )
import           System.FilePath ( dropFileName )
import qualified System.Posix.Files as P
import qualified System.Posix.Types as P

import           Network.Mattermost.Lenses
import           Network.Mattermost.Types

import           Matterhorn.FilePaths
import           Matterhorn.IOUtil
import           Matterhorn.Types


-- | Run state of the program. This is saved in a file on program exit and
-- | looked up from the file on program startup.
data LastRunState =
    LastRunState { LastRunState -> Hostname
_lrsHost              :: Hostname  -- ^ Host of the server
                 , LastRunState -> Port
_lrsPort              :: Port      -- ^ Post of the server
                 , LastRunState -> UserId
_lrsUserId            :: UserId    -- ^ ID of the logged-in user
                 , LastRunState -> Maybe ChannelId
_lrsSelectedChannelId :: Maybe ChannelId -- ^ ID of the last selected channel
                 , LastRunState -> Maybe (ChannelId, PostId)
_lrsOpenThread        :: Maybe (ChannelId, PostId)
                 }

instance A.ToJSON LastRunState where
    toJSON :: LastRunState -> Value
toJSON LastRunState
lrs = [Pair] -> Value
A.object [ Key
"host"           forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= LastRunState -> Hostname
_lrsHost LastRunState
lrs
                          , Key
"port"           forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= LastRunState -> Port
_lrsPort LastRunState
lrs
                          , Key
"user_id"        forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= LastRunState -> UserId
_lrsUserId LastRunState
lrs
                          , Key
"sel_channel_id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= LastRunState -> Maybe ChannelId
_lrsSelectedChannelId LastRunState
lrs
                          , Key
"open_thread"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= LastRunState -> Maybe (ChannelId, PostId)
_lrsOpenThread LastRunState
lrs
                          ]

instance A.FromJSON LastRunState where
    parseJSON :: Value -> Parser LastRunState
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"LastRunState" forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Hostname
-> Port
-> UserId
-> Maybe ChannelId
-> Maybe (ChannelId, PostId)
-> LastRunState
LastRunState
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"host"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"port"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"user_id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"sel_channel_id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"open_thread"

makeLenses ''LastRunState

toLastRunState :: ChatState -> TeamId -> LastRunState
toLastRunState :: ChatState -> TeamId -> LastRunState
toLastRunState ChatState
cs TeamId
tId =
    LastRunState { _lrsHost :: Hostname
_lrsHost              = ChatState
csforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources ConnectionData
crConnforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ConnectionData Hostname
cdHostnameL
                 , _lrsPort :: Port
_lrsPort              = ChatState
csforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources ConnectionData
crConnforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ConnectionData Port
cdPortL
                 , _lrsUserId :: UserId
_lrsUserId            = ChatState -> UserId
myUserId ChatState
cs
                 , _lrsSelectedChannelId :: Maybe ChannelId
_lrsSelectedChannelId = ChatState
csforall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId(TeamId
tId)
                 , _lrsOpenThread :: Maybe (ChannelId, PostId)
_lrsOpenThread = do
                     ThreadInterface
ti <- ChatState
csforall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ThreadInterface)
tsThreadInterface
                     forall (m :: * -> *) a. Monad m => a -> m a
return (ThreadInterface
tiforall s a. s -> Getting a s a -> a
^.forall n i. Lens' (MessageInterface n i) ChannelId
miChannelId, ThreadInterface
tiforall s a. s -> Getting a s a -> a
^.forall n i1 i2.
Lens (MessageInterface n i1) (MessageInterface n i2) i1 i2
miRootPostId)
                 }

lastRunStateFileMode :: P.FileMode
lastRunStateFileMode :: FileMode
lastRunStateFileMode = FileMode -> FileMode -> FileMode
P.unionFileModes FileMode
P.ownerReadMode FileMode
P.ownerWriteMode

-- | Writes the run state to a file. The file is specific to the current team.
-- | Writes only if the current channel is an ordrinary or a private channel.
writeLastRunStates :: ChatState -> IO ()
writeLastRunStates :: ChatState -> IO ()
writeLastRunStates ChatState
cs =
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k v. HashMap k v -> [k]
HM.keys forall a b. (a -> b) -> a -> b
$ ChatState
csforall s a. s -> Getting a s a -> a
^.Lens' ChatState (HashMap TeamId TeamState)
csTeams) forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
        ChatState -> TeamId -> IO ()
writeLastRunState ChatState
cs TeamId
tId

writeLastRunState :: ChatState -> TeamId -> IO ()
writeLastRunState :: ChatState -> TeamId -> IO ()
writeLastRunState ChatState
cs TeamId
tId =
    case ChatState
csforall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId(TeamId
tId) of
        Maybe ChannelId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just ChannelId
cId -> case ChatState
csforall s a. s -> Getting (First a) s a -> Maybe a
^?ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId) of
            Maybe ClientChannel
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just ClientChannel
chan ->
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Type
cdType forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Type
Ordinary, Type
Private]) forall a b. (a -> b) -> a -> b
$ do
                    let runState :: LastRunState
runState = ChatState -> TeamId -> LastRunState
toLastRunState ChatState
cs TeamId
tId

                    String
lastRunStateFile <- Hostname -> IO String
lastRunStateFilePath forall a b. (a -> b) -> a -> b
$ Id -> Hostname
unId forall a b. (a -> b) -> a -> b
$ forall x. IsId x => x -> Id
toId TeamId
tId
                    Bool -> String -> IO ()
createDirectoryIfMissing Bool
True forall a b. (a -> b) -> a -> b
$ String -> String
dropFileName String
lastRunStateFile
                    String -> ByteString -> IO ()
BS.writeFile String
lastRunStateFile forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.toStrict forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
A.encode LastRunState
runState
                    String -> FileMode -> IO ()
P.setFileMode String
lastRunStateFile FileMode
lastRunStateFileMode

-- | Reads the last run state from a file given the current team ID.
readLastRunState :: TeamId -> IO (Either String LastRunState)
readLastRunState :: TeamId -> IO (Either String LastRunState)
readLastRunState TeamId
tId = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
    ByteString
contents <- forall a. IO a -> ExceptT String IO a
convertIOException forall a b. (a -> b) -> a -> b
$
        Hostname -> IO String
lastRunStateFilePath (Id -> Hostname
unId forall a b. (a -> b) -> a -> b
$ forall x. IsId x => x -> Id
toId TeamId
tId) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ByteString
BS.readFile
    case forall a. FromJSON a => ByteString -> Either String a
A.eitherDecodeStrict' ByteString
contents of
        Right LastRunState
val -> forall (m :: * -> *) a. Monad m => a -> m a
return LastRunState
val
        Left String
err -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall a b. (a -> b) -> a -> b
$ String
"Failed to parse lastRunState file: " forall a. [a] -> [a] -> [a]
++ String
err

-- | Checks if the given last run state is valid for the current server and user.
isValidLastRunState :: ChatResources -> User -> LastRunState -> Bool
isValidLastRunState :: ChatResources -> User -> LastRunState -> Bool
isValidLastRunState ChatResources
cr User
me LastRunState
rs =
    forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ LastRunState
rsforall s a. s -> Getting a s a -> a
^.Lens' LastRunState Hostname
lrsHost   forall a. Eq a => a -> a -> Bool
== ChatResources
crforall s a. s -> Getting a s a -> a
^.Lens' ChatResources ConnectionData
crConnforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ConnectionData Hostname
cdHostnameL
        , LastRunState
rsforall s a. s -> Getting a s a -> a
^.Lens' LastRunState Port
lrsPort   forall a. Eq a => a -> a -> Bool
== ChatResources
crforall s a. s -> Getting a s a -> a
^.Lens' ChatResources ConnectionData
crConnforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ConnectionData Port
cdPortL
        , LastRunState
rsforall s a. s -> Getting a s a -> a
^.Lens' LastRunState UserId
lrsUserId forall a. Eq a => a -> a -> Bool
== User
meforall s a. s -> Getting a s a -> a
^.Lens' User UserId
userIdL
        ]