{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE PolyKinds #-}

module Main where

import HBS2.Actors.Peer
import HBS2.Clock
import HBS2.Net.Messaging.Unix
import HBS2.Net.Proto
import HBS2.Prelude.Plated
import HBS2.Net.Proto.Service

import HBS2.System.Logger.Simple

import Codec.Serialise
import Control.Monad.Reader
import Data.ByteString.Lazy (ByteString)
import System.FilePath.Posix
import System.IO
import System.IO.Temp
import UnliftIO.Async
import Data.List

import Test.Tasty.HUnit

data Method1
data Method2

type MyServiceMethods1 = '[ Method1, Method2 ]

instance HasProtocol UNIX  (ServiceProto MyServiceMethods1 UNIX) where
  type instance ProtocolId (ServiceProto MyServiceMethods1 UNIX) = 1
  type instance Encoded UNIX = ByteString
  decode = either (const Nothing) Just . deserialiseOrFail
  encode = serialise

instance MonadIO m => HandleMethod m Method1 where
  type instance Input Method1 = String
  type instance Output Method1 = String
  handleMethod n = do
    debug $ "SERVICE1. METHOD1" <+> pretty n
    case n of
      "JOPA"   -> pure "KITA"
      "PECHEN" -> pure "TRESKI"
      _        -> pure "X3"

instance MonadIO m => HandleMethod m Method2 where
  type instance Input Method2 = ()
  type instance Output Method2 = ()
  handleMethod _ = pure ()


instance Monad m => HasFabriq UNIX (ReaderT MessagingUnix m) where
  getFabriq = asks Fabriq

instance Monad m => HasOwnPeer UNIX (ReaderT MessagingUnix m) where
  ownPeer = asks msgUnixSelf

instance HasProtocol e (ServiceProto api e) => HasTimeLimits e (ServiceProto api e) IO where
  tryLockForPeriod _ _ = pure True


main :: IO ()
main = do

  setLogging @DEBUG  (logPrefix "[debug] ")
  setLogging @INFO   (logPrefix "")
  setLogging @ERROR  (logPrefix "[err] ")
  setLogging @WARN   (logPrefix "[warn] ")
  setLogging @NOTICE (logPrefix "[notice] ")
  setLogging @TRACE  (logPrefix "[trace] ")

  liftIO $ hSetBuffering stdout LineBuffering
  liftIO $ hSetBuffering stderr LineBuffering

  withSystemTempDirectory "test-unix-socket" $ \tmp -> do

    let soname = tmp </> "unix.socket"

    server <- newMessagingUnixOpts [MUFork] True 1.0 soname
    client1 <- newMessagingUnix False 1.0 soname

    m1 <- async $ runMessagingUnix server

    pause @'Seconds 0.10

    m2 <- async $ runMessagingUnix client1

    p1 <- async $ flip runReaderT server do
                    runProto @UNIX
                      [ makeResponse (makeServer @MyServiceMethods1)
                      ]

    caller <- makeServiceCaller @MyServiceMethods1 @UNIX (msgUnixSelf server)

    p2 <- async $ runReaderT (runServiceClient caller) client1

    link p1
    link p2

    results <- forConcurrently ["JOPA", "PECHEN", "WTF?"] $ \r -> do
                answ <- callService @Method1 caller r
                pure (r, answ)

    debug $ "GOT RESPONSES (Method1): " <+> viaShow results

    assertBool "assert1" (sortOn fst results == [("JOPA",Right "KITA"),("PECHEN",Right "TRESKI"),("WTF?",Right "X3")] )

    r2 <- callService @Method2 caller ()

    debug $ "GOT RESPONSE (Method2): " <+> viaShow r2

    assertBool "assert2" (r2 == Right ())

    cancel p1
    pause @'Seconds 0.10

    waitAnyCatchCancel [p1,p2,m1,m2]

  setLoggingOff @DEBUG
  setLoggingOff @INFO
  setLoggingOff @ERROR
  setLoggingOff @WARN
  setLoggingOff @NOTICE
  setLoggingOff @TRACE