{-# LANGUAGE TemplateHaskell #-}
module Matterhorn.LastRunState
  ( LastRunState
  , lrsHost
  , lrsPort
  , lrsUserId
  , lrsSelectedChannelId
  , 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 -> ChannelId
_lrsSelectedChannelId :: ChannelId -- ^ ID of the last selected channel
  }

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

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

makeLenses ''LastRunState

toLastRunState :: ChatState -> LastRunState
toLastRunState :: ChatState -> LastRunState
toLastRunState ChatState
cs = LastRunState :: Hostname -> Port -> UserId -> ChannelId -> LastRunState
LastRunState
  { _lrsHost :: Hostname
_lrsHost              = ChatState
csChatState -> Getting Hostname ChatState Hostname -> Hostname
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const Hostname ChatResources)
-> ChatState -> Const Hostname ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Hostname ChatResources)
 -> ChatState -> Const Hostname ChatState)
-> ((Hostname -> Const Hostname Hostname)
    -> ChatResources -> Const Hostname ChatResources)
-> Getting Hostname ChatState Hostname
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ConnectionData -> Const Hostname ConnectionData)
-> ChatResources -> Const Hostname ChatResources
Lens' ChatResources ConnectionData
crConn((ConnectionData -> Const Hostname ConnectionData)
 -> ChatResources -> Const Hostname ChatResources)
-> ((Hostname -> Const Hostname Hostname)
    -> ConnectionData -> Const Hostname ConnectionData)
-> (Hostname -> Const Hostname Hostname)
-> ChatResources
-> Const Hostname ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Hostname -> Const Hostname Hostname)
-> ConnectionData -> Const Hostname ConnectionData
Lens' ConnectionData Hostname
cdHostnameL
  , _lrsPort :: Port
_lrsPort              = ChatState
csChatState -> Getting Port ChatState Port -> Port
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const Port ChatResources)
-> ChatState -> Const Port ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Port ChatResources)
 -> ChatState -> Const Port ChatState)
-> ((Port -> Const Port Port)
    -> ChatResources -> Const Port ChatResources)
-> Getting Port ChatState Port
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ConnectionData -> Const Port ConnectionData)
-> ChatResources -> Const Port ChatResources
Lens' ChatResources ConnectionData
crConn((ConnectionData -> Const Port ConnectionData)
 -> ChatResources -> Const Port ChatResources)
-> ((Port -> Const Port Port)
    -> ConnectionData -> Const Port ConnectionData)
-> (Port -> Const Port Port)
-> ChatResources
-> Const Port ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Port -> Const Port Port)
-> ConnectionData -> Const Port ConnectionData
Lens' ConnectionData Port
cdPortL
  , _lrsUserId :: UserId
_lrsUserId            = ChatState -> UserId
myUserId ChatState
cs
  , _lrsSelectedChannelId :: ChannelId
_lrsSelectedChannelId = ChatState
csChatState -> Getting ChannelId ChatState ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId(ChatState
csChatState -> Getting TeamId ChatState TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^.Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId)
  }

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 =
    [TeamId] -> (TeamId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (HashMap TeamId TeamState -> [TeamId]
forall k v. HashMap k v -> [k]
HM.keys (HashMap TeamId TeamState -> [TeamId])
-> HashMap TeamId TeamState -> [TeamId]
forall a b. (a -> b) -> a -> b
$ ChatState
csChatState
-> Getting
     (HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
-> HashMap TeamId TeamState
forall s a. s -> Getting a s a -> a
^.Getting
  (HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
Lens' ChatState (HashMap TeamId TeamState)
csTeams) ((TeamId -> IO ()) -> IO ()) -> (TeamId -> IO ()) -> IO ()
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 = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChatState
csChatState -> Getting Type ChatState Type -> Type
forall s a. s -> Getting a s a -> a
^.(ClientChannel -> Const Type ClientChannel)
-> ChatState -> Const Type ChatState
Lens' ChatState ClientChannel
csCurrentChannel((ClientChannel -> Const Type ClientChannel)
 -> ChatState -> Const Type ChatState)
-> ((Type -> Const Type Type)
    -> ClientChannel -> Const Type ClientChannel)
-> Getting Type ChatState Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Const Type ChannelInfo)
-> ClientChannel -> Const Type ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const Type ChannelInfo)
 -> ClientChannel -> Const Type ClientChannel)
-> ((Type -> Const Type Type)
    -> ChannelInfo -> Const Type ChannelInfo)
-> (Type -> Const Type Type)
-> ClientChannel
-> Const Type ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Type -> Const Type Type) -> ChannelInfo -> Const Type ChannelInfo
Lens' ChannelInfo Type
cdType Type -> [Type] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Type
Ordinary, Type
Private]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        let runState :: LastRunState
runState = ChatState -> LastRunState
toLastRunState ChatState
cs

        String
lastRunStateFile <- Hostname -> IO String
lastRunStateFilePath (Hostname -> IO String) -> Hostname -> IO String
forall a b. (a -> b) -> a -> b
$ Id -> Hostname
unId (Id -> Hostname) -> Id -> Hostname
forall a b. (a -> b) -> a -> b
$ TeamId -> Id
forall x. IsId x => x -> Id
toId TeamId
tId
        Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
dropFileName String
lastRunStateFile
        String -> ByteString -> IO ()
BS.writeFile String
lastRunStateFile (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ LastRunState -> ByteString
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 = ExceptT String IO LastRunState -> IO (Either String LastRunState)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO LastRunState -> IO (Either String LastRunState))
-> ExceptT String IO LastRunState
-> IO (Either String LastRunState)
forall a b. (a -> b) -> a -> b
$ do
  ByteString
contents <- IO ByteString -> ExceptT String IO ByteString
forall a. IO a -> ExceptT String IO a
convertIOException (IO ByteString -> ExceptT String IO ByteString)
-> IO ByteString -> ExceptT String IO ByteString
forall a b. (a -> b) -> a -> b
$
    Hostname -> IO String
lastRunStateFilePath (Id -> Hostname
unId (Id -> Hostname) -> Id -> Hostname
forall a b. (a -> b) -> a -> b
$ TeamId -> Id
forall x. IsId x => x -> Id
toId TeamId
tId) IO String -> (String -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ByteString
BS.readFile
  case ByteString -> Either String LastRunState
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecodeStrict' ByteString
contents of
    Right LastRunState
val -> LastRunState -> ExceptT String IO LastRunState
forall (m :: * -> *) a. Monad m => a -> m a
return LastRunState
val
    Left String
err -> String -> ExceptT String IO LastRunState
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (String -> ExceptT String IO LastRunState)
-> String -> ExceptT String IO LastRunState
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse lastRunState file: " String -> String -> String
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 =
     LastRunState
rsLastRunState -> Getting Hostname LastRunState Hostname -> Hostname
forall s a. s -> Getting a s a -> a
^.Getting Hostname LastRunState Hostname
Lens' LastRunState Hostname
lrsHost   Hostname -> Hostname -> Bool
forall a. Eq a => a -> a -> Bool
== ChatResources
crChatResources
-> ((Hostname -> Const Hostname Hostname)
    -> ChatResources -> Const Hostname ChatResources)
-> Hostname
forall s a. s -> Getting a s a -> a
^.(ConnectionData -> Const Hostname ConnectionData)
-> ChatResources -> Const Hostname ChatResources
Lens' ChatResources ConnectionData
crConn((ConnectionData -> Const Hostname ConnectionData)
 -> ChatResources -> Const Hostname ChatResources)
-> ((Hostname -> Const Hostname Hostname)
    -> ConnectionData -> Const Hostname ConnectionData)
-> (Hostname -> Const Hostname Hostname)
-> ChatResources
-> Const Hostname ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Hostname -> Const Hostname Hostname)
-> ConnectionData -> Const Hostname ConnectionData
Lens' ConnectionData Hostname
cdHostnameL
  Bool -> Bool -> Bool
&& LastRunState
rsLastRunState -> Getting Port LastRunState Port -> Port
forall s a. s -> Getting a s a -> a
^.Getting Port LastRunState Port
Lens' LastRunState Port
lrsPort   Port -> Port -> Bool
forall a. Eq a => a -> a -> Bool
== ChatResources
crChatResources
-> ((Port -> Const Port Port)
    -> ChatResources -> Const Port ChatResources)
-> Port
forall s a. s -> Getting a s a -> a
^.(ConnectionData -> Const Port ConnectionData)
-> ChatResources -> Const Port ChatResources
Lens' ChatResources ConnectionData
crConn((ConnectionData -> Const Port ConnectionData)
 -> ChatResources -> Const Port ChatResources)
-> ((Port -> Const Port Port)
    -> ConnectionData -> Const Port ConnectionData)
-> (Port -> Const Port Port)
-> ChatResources
-> Const Port ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Port -> Const Port Port)
-> ConnectionData -> Const Port ConnectionData
Lens' ConnectionData Port
cdPortL
  Bool -> Bool -> Bool
&& LastRunState
rsLastRunState -> Getting UserId LastRunState UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId LastRunState UserId
Lens' LastRunState UserId
lrsUserId UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
== User
meUser -> Getting UserId User UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId User UserId
Lens' User UserId
userIdL