{-# LANGUAGE 
      BlockArguments 
    , ViewPatterns
    , OverloadedStrings
    , RecordWildCards
    , LambdaCase
    #-}
module Lightning.Client where 

import Control.Monad.IO.Class
import Data.Aeson
import Data.Aeson.Types hiding (parse)
import qualified Data.ByteString as S
import Data.Attoparsec.ByteString 
import Data.ByteString.Lazy as L 
import Data.Conduit
import System.IO 
import Control.Monad
import GHC.Generics
import Data.Text (Text)
import Control.Applicative  ((<|>))
import Control.Monad.State.Lazy
import System.IO.Unsafe
import Data.IORef
import Data.Conduit.Combinators hiding (stdout, stderr, stdin) 

type PartialCommand = Value -> Command 
instance Show PartialCommand where 
    show x = show $ (x "") 

{-# NOINLINE idref #-} 
idref :: IORef Int
idref = unsafePerformIO $ newIORef 1

-- | commands to core lightning are defined by the set of plugins and version of core lightning so this is generic and you should refer to lightning-cli help <command> for the details of the command you are interested in. A filter object is used to specify the data you desire returned (i.e. {"id":True}) and params are the named fields of the command. 
data Command = Command { 
      method :: Text
    , reqFilter :: Maybe Value
    , params :: Value 
    , ____id :: Value 
    } deriving (Show) 
instance ToJSON Command where 
    toJSON (Command m Nothing p i) = 
        object [ "jsonrpc" .= ("2.0" :: Text)
               , "id" .= i
               , "method"  .= m 
               , "params" .= toJSON p
               ]
    toJSON (Command m (Just f) p i) = 
        object [ "jsonrpc" .= ("2.0" :: Text)
               , "id" .= i
               , "filter" .= toJSON f
               , "method"  .= m 
               , "params" .= toJSON p
               ]

-- | interface with lightning-rpc.  
lightningCli :: (MonadIO m) => 
                 Handle -> (PartialCommand -> m (Maybe (Res Value)))
lightningCli h v = do 
    i <- liftIO $ atomicModifyIORef idref $ (\x -> (x,x)).(+1)
    liftIO $ L.hPutStr h . encode $ v (toJSON i) 
    liftIO $ runConduit $ sourceHandle h .| inConduit .| await >>= \case 
        (Just (Correct x)) -> pure $ Just x
        _ -> pure Nothing 

-- | log wrapper for easier debugging during development.
-- lightningCliDebug :: (MonadReader Plug m, MonadIO m) => 
--                      (String -> IO ()) -> PartialCommand -> m (Maybe (Res Value))
-- lightningCliDebug logger v = do 
--     log' v
--     res <- lightningCli v 
--     log' res 
--     pure res 
--     where 
--         log' :: (Show a, MonadIO m) => a -> m () 
--         log' = liftIO . logger . show
-- 
-- | Decode from bytestring into a JSON object. Simplified from hackage package: json-rpc 
inConduit :: (Monad n) => (FromJSON a) => ConduitT S.ByteString (ParseResult a) n ()
inConduit = evalStateT l Nothing
    where 
    l = lift await >>= maybe (lift mempty) (r >=> h)
    r i = get  >>= \case
        Nothing -> pure $ parse json' i
        Just k  ->  pure $ k i 
    h = \case
        Fail{} -> lift (yield ParseErr) 
        Partial i -> put (Just i) >> l
        Done _ v -> lift $ yield $ fin $ parseMaybe parseJSON v 
    fin = \case
        Nothing -> InvalidReq
        Just c -> Correct c

data ParseResult x =  Correct !x | InvalidReq |  ParseErr 
    deriving (Show, Generic) 
instance ToJSON a => ToJSON (ParseResult a) where 
    toJSON = genericToJSON defaultOptions 
instance FromJSON a => FromJSON (ParseResult a) 
data Req x = Req { 
   getMethod :: Text,
   getParams :: x,
   getReqId :: Maybe Value }
   deriving (Show) 
   
data Res a =
    Res { getResBody :: a,
          getResId :: Value }
    | ErrRes  {
          errMsg :: Text,
          errId :: Maybe Value }
    deriving (Show, Generic)

instance FromJSON (Req Value) where
    parseJSON (Object v) = do
        version <- v .: "jsonrpc"
        guard (version == ("2.0" :: Text))
        Req <$> v .:  "method"
            <*> (v .:? "params") .!= emptyArray
            <*> v .:?  "id"
    parseJSON _ = mempty

instance FromJSON a => FromJSON (Res a) where
    parseJSON (Object v) = do
        version <- v .: "jsonrpc"
        guard (version == ("2.0" :: Text))
        fromResult <|> fromError
        where
            fromResult = Res <$> (v .: "result" >>= parseJSON)
                             <*> v .: "id"
            fromError = do
                err <- v .: "error"
                ErrRes  <$> err .: "message"
                      <*> v   .: "id"
    parseJSON (Array _) = mempty
    parseJSON _ = mempty

instance ToJSON a => ToJSON (Req a) where
    toJSON (Req m ps i) =
        object [ "jsonrpc" .= ("2.0" :: Text)
               , "method"  .= m
               , "params"  .= toJSON ps
               , "id"      .= i ]

instance ToJSON (Res Value) where
    toJSON (Res x i) = object [ 
        "jsonrpc" .= ("2.0" :: Text),
        "result"  .= x,
        "id"      .= i ]
    toJSON (ErrRes msg i) = object [ 
        "jsonrpc" .= ("2.0" :: Text),
        "error"   .= object ["message" .= msg],
         "id"      .= i ]