-- Copyright 2013 Joseph Tel Abrahamson
--
-- Licensed under the Apache License, Version 2.0 (the "License"); you
-- may not use this file except in compliance with the License. You
-- may obtain a copy of the License at
-- 
--   http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
-- implied. See the License for the specific language governing
-- permissions and limitations under the License.

-- |
-- Module      : Network.Nanomsg.C.Core
-- Copyright   : (c) Joseph Abrahamson 2013
-- License     : Apache 2.0
-- 
-- Maintainer  : me@jspha.com
-- Stability   : experimental
-- Portability : non-portable
-- 
-- TODO: Refactor some of the messy error handling code.

{-# LANGUAGE GeneralizedNewtypeDeriving,
             RankNTypes,
             FlexibleInstances #-}
module Network.Nanomsg.C.Core (

  -- * Basic API

  -- These are the primary functions for interacting with Nanomsg. The
  -- majority of the types exported from this module are used to work
  -- with these functions in a typesafe manner.

  Socket (..), Endpoint (..), new, bind, connect, shutdown,
  EndpointError (..),
  
  -- Socket, Endpoint,
  -- newSocket, new, raw, close,
  -- setOpt,
  -- bind, connect, shutdown,

  ) where

import Control.Exception

import Foreign (Storable)
import Foreign.C.Types
import Foreign.C.String
import System.Posix.Types

import GHC.IO.Exception

import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString as S

import Network.Nanomsg.C.Protocols
import Network.Nanomsg.C.Domains
import Network.Nanomsg.C.Address
import Network.Nanomsg.C.Errors

-- | Sockets are just wrappers over file handles. They have two
-- phantom type variables, the first of which ensures that sockets are
-- used in single-threaded environments the second indicates what kind
-- of scalability protocol the socket is attuned to.
newtype Socket s p = Socket Fd deriving (Eq, Storable)

instance Show (Socket s Pair)       where show _ = "Socket{Pair}"
instance Show (Socket s Req)        where show _ = "Socket{Req}"
instance Show (Socket s Rep)        where show _ = "Socket{Rep}"
instance Show (Socket s Pub)        where show _ = "Socket{Pub}"
instance Show (Socket s Sub)        where show _ = "Socket{Sub}"
instance Show (Socket s Surveyor)   where show _ = "Socket{Surveyor}"
instance Show (Socket s Respondent) where show _ = "Socket{Respondent}"
instance Show (Socket s Source)     where show _ = "Socket{Source}"
instance Show (Socket s Sink)       where show _ = "Socket{Sink}"
instance Show (Socket s Push)       where show _ = "Socket{Push}"
instance Show (Socket s Pull)       where show _ = "Socket{Pull}"


-- | Endpoint IDs are generated by 'bind' and 'connect' and handed to
-- 'shutdown' to terminate them. Endpoint IDs are *socket-local*---it
-- is not (necessarily) an error but semantically nonsensical to hand
-- an endpoint from one socket to some different socket. To ensure
-- this, they have a phantom type variable which must match that of
-- the socket.
data Endpoint s = Endpoint
                  CInt         -- ^ The endpoint identifier
                  S.ByteString -- ^ The address it was bound on

instance Eq (Endpoint s) where
  Endpoint a _ == Endpoint b _ = a == b

instance Show (Endpoint s) where
  show (Endpoint _ addy) = "Endpoint{" ++ S8.unpack addy ++ "}"

-- | A generic error handler. Takes a list of error responses and a
-- postprocessing function and turns nanomsg return values into
-- something more meaningful.
rErrorHandler
  :: String -> CInt -> (CInt -> IO b) -> [(Errno, IO b)] -> IO b
rErrorHandler name res end cases
  | res < 0 = do
    e <- nnGetErrno
    case lookup e cases of
      Nothing  ->
        -- We're not handling that error, it must be "impossible"
        error $ "Network.Nanomsg.C.Core." ++ name ++ " \"impossible\" error"
      Just val -> val
  | otherwise = end res

-- | Upgrade @EMFILE@ to an 'IOError'.
eMFile :: String -> IO a
eMFile name = ioError $ IOError
  { ioe_handle      = Nothing
  , ioe_type        = ResourceExhausted
  , ioe_location    = "Network.Nanomsg.C.Core." ++ name
  , ioe_description = show eMFILE
  , ioe_errno       = Just (errnoInt eMFILE)
  , ioe_filename    = Nothing
  }

-- | Upgrade @ETERM@ to an 'IOError'.
eTerm :: String -> IO a
eTerm name = ioError $ IOError
  { ioe_handle      = Nothing
  , ioe_type        = IllegalOperation
  , ioe_location    = "Network.Nanomsg.C.Core." ++ name
  , ioe_description = show eTERM
  , ioe_errno       = Just (errnoInt eTERM)
  , ioe_filename    = Nothing
  }

-- | Runs a continuation giving it a fresh socket of the desired
-- kind. Ensures that socket endpoints are local to a particular
-- socket and that the socket is properly closed. Can throw exceptions
-- when system-level problems are encountered.
new :: Protocol p => Domain -> p -> (forall s. Socket s p -> IO r) -> IO r
new domain protocol k = do  
  sockInt <- nn_socket domain (proValue protocol)
  sock <- rErrorHandler "new" sockInt (return . Socket . Fd)

  -- Socket creation has failed.
  --
  -- The possible reasons for this failure are the following:
  -- 
  -- EINVAL "Unknown protocol."  Impossible --- types ensure that
  -- only valid families are used
  --
  -- EAFNOSUPPORT "Specified address family is not supported."
  -- Impossible --- types ensure that only valid families are used

    [ (eMFILE, eMFile "new")

      -- EMFILE "The limit on the total number of open SP sockets or
      -- OS limit for file descriptors has been reached." Major
      -- failure --- there's no reasonable way for this local thread
      -- to handle this error.

    , (eTERM, eTerm "new")

      -- ETERM "The library is terminating." Major failure --- there's
      -- no reasonable way for this local thread to handle this error.
      
    ]

  -- Then we'll finally run the continuation with the socket
  k sock `finally` tryHardToClose sock

-- | Tries hard to close a 'Socket'. This operation *blocks* like any
-- 'Socket' @close@ operation, so it's possible it'll get interrupted
-- by the end user. "Trying hard" thus means that in the event of such
-- interruptions we retry closing the socket.
-- 
-- TODO: Should we just retry forever? Otherwise sockets might need to
-- store a "death-counter" which indicates how many times we've tried
-- to close them.
tryHardToClose :: Socket s p -> IO ()
tryHardToClose s = do
  res <- nn_close s
  case res of
    n | n == 0 -> return ()

    -- Socket closure failed.
    --
    -- The only possible reasons for failure are
    --
    -- EBADF "The provided socket is invalid." Should be impossible
    -- due to types.
    --
    -- EINTR "Operation was interrupted by a signal. The socket is not
    -- fully closed yet. Operation can be re-started by calling
    -- nn_close() again."
    --
    -- In the event we get EINTR we'll retry this closure.
      | otherwise -> do
      errno <- nnGetErrno
      case errno of
        e | e == eINTR -> tryHardToClose s
          | otherwise ->
            error "Network.Nanomsg.C.Core.withNew \"impossible\" error"

-- | A selection of errors that may occur at runtime during 'bind's
-- and 'connect's.
data EndpointError
  = NonexistentDevice
    -- ^ "Address specifies a nonexistent interface."
  | AddressInUse
    -- ^ "The requested local endpoint is already in use."
  | AddressTooLong
    -- ^ "The supplied address is too long."
  | UnavailableInterface
    -- ^"The requested endpoint is not local."
  | UnsupportedProtocol
    -- ^ "The requested transport protocol is not supported."
    deriving (Eq, Ord)

instance Show EndpointError where
  show NonexistentDevice    = "Address specifies a nonexistent interface."
  show AddressInUse         = "The requested local endpoint is already in use."
  show AddressTooLong       = "The supplied address is too long."
  show UnsupportedProtocol  = "The requested transport protocol is not supported."
  show UnavailableInterface = "The requested endpoint is not local."
  
    
-- | Binds a a 'Socket' to an 'Address' and get an 'Endpoint'
-- representing that binding.
bind :: Socket s p -> Address tr Bind -> IO (Either EndpointError (Endpoint s))
bind socket address = S.useAsCString (ser address) $ \cstr -> do
    res <- nn_bind socket cstr
    rErrorHandler "bind" res (return . Right . (flip Endpoint $ ser address))

    -- Address binding has failed
    --
    -- This operation could fail for many reasons, ordered by how
    -- likely they are to be handled in the runtime.
    --
    -- EBADF "The provided socket is invalid." Impossible,
    -- constrained by types.
    -- 
    -- EINVAL "The syntax of the supplied address is invalid."
    -- Impossible, constrained by types once 'Address'es are
    -- in-place.

      [ (eNODEV, return $ Left NonexistentDevice)

      -- ENODEV "Address specifies a nonexistent interface."
      -- Absolutely a handleable runtime error.

      , (eADDRINUSE, return $ Left AddressInUse)
        
      -- EADDRINUSE "The requested local endpoint is already in use."
      -- Absolutely a handleable runtime error.

      , (eNAMETOOLONG, return $ Left AddressTooLong)
        
      -- ENAMETOOLONG "The supplied address is too long." Possible and
      -- only checkable at runtime (How early can we check it though?
      -- Can we have the ToString instance of 'Address' throw errors
      -- immediately?). We'll pass this back (for now).
      --
      -- TODO: Finish 'IsString' for 'Address'.

      , (eADDRNOTAVAIL, return $ Left UnavailableInterface)
        
      -- EADDRNOTAVAIL "The requested endpoint is not local."
      -- Restricted somewhat, but if the user tries to connect on an
      -- interface that doesn't exist then this will happen.

      , (ePROTONOSUPPORT, return $ Left UnsupportedProtocol)
        
      -- EPROTONOSUPPORT "The requested transport protocol is not
      -- supported." I'm uncertain why this error would occur. Can it
      -- be constrained by types?
      --
      -- TODO: Constrain EPROTONOSUPPORT with types.

      , (eMFILE, eMFile "bind")
        
      -- EMFILE "Maximum number of active endpoints was reached." It's
      -- *possible* that this could be handled in process. Unsure what
      -- to do about it, really. Right now it'll be considered an
      -- IOError akin to running out of file handlers.
      --
      -- TODO: Describe reasons for and against exposing this error to
      -- the user.

      , (eTERM, eTerm "bind")
        
      -- ETERM "The library is terminating." Unsalvagable, we'll
      -- upgrade it to a Haskell 'IOException'.

      ]

-- | Binds a a 'Socket' to an 'Address' and get an 'Endpoint'
-- representing that binding.
connect :: Socket s p -> Address tr Connect -> IO (Either EndpointError (Endpoint s))
connect socket address =
  S.useAsCString (ser address) $ \cstr -> do
    res <- nn_connect socket cstr
    rErrorHandler "connect" res (return . Right . (flip Endpoint $ ser address))

    -- Address binding has failed
    --
    -- This operation could fail for many reasons, ordered by how
    -- likely they are to be handled in the runtime.
    --
    -- EBADF "The provided socket is invalid." Impossible,
    -- constrained by types.
    -- 
    -- EINVAL "The syntax of the supplied address is invalid."
    -- Impossible, constrained by types once 'Address'es are
    -- in-place.

      [ (eNODEV, return $ Left NonexistentDevice)

      -- ENODEV "Address specifies a nonexistent interface."
      -- Absolutely a handleable runtime error.

      , (eNAMETOOLONG, return $ Left AddressTooLong)
        
      -- ENAMETOOLONG "The supplied address is too long." Possible and
      -- only checkable at runtime (How early can we check it though?
      -- Can we have the ToString instance of 'Address' throw errors
      -- immediately?). We'll pass this back (for now).
      --
      -- TODO: Finish 'IsString' for 'Address'.

      , (ePROTONOSUPPORT, return $ Left UnsupportedProtocol)
        
      -- EPROTONOSUPPORT "The requested transport protocol is not
      -- supported." I'm uncertain why this error would occur. Can it
      -- be constrained by types?
      --
      -- TODO: Constrain EPROTONOSUPPORT with types.

      , (eMFILE, eMFile "connect")
        
      -- EMFILE "Maximum number of active endpoints was reached." It's
      -- *possible* that this could be handled in process. Unsure what
      -- to do about it, really. Right now it'll be considered an
      -- IOError akin to running out of file handlers.
      --
      -- TODO: Describe reasons for and against exposing this error to
      -- the user.

      , (eTERM, eTerm "connect")
        
      -- ETERM "The library is terminating." Unsalvagable, we'll
      -- upgrade it to a Haskell 'IOException'.

      ]

-- | Removes an 'Endpoint' from its 'Socket'. Remaining messages will
-- be attempted until the linger time expires, so this is
-- blocking. Idempotent.
shutdown :: Socket s p -> Endpoint s -> IO ()
shutdown socket e@(Endpoint ep _) = do
  res <- nn_shutdown socket ep
  rErrorHandler "shutdown" res (const $ return ())

    -- Endpoint shutdown has failed
    --
    -- This operation could fail for any of the following reasons.
    --
    -- EBADF "The provided socket is invalid." Impossible, constrained
    -- by types.
    -- 
  
    [ (eINVAL, return ())
      
      -- EINVAL "The syntax of the supplied address is invalid."  The
      -- endpoint isn't active. This is partially constrained by the
      -- types---endpoints cannot be shutdown on the wrong socket---so
      -- we'll actually just ignore this error and render the high-level
      -- call idempotent.

    , (eINTR, shutdown socket e)
        
      -- EINTR "Operation was interrupted by a signal. The endpoint is
      -- not fully closed yet. Operation can be re-started by calling
      -- shutdown again." So, we do just that.

    , (eTERM, eTerm "shutdown")

      -- ETERM "The library is terminating." Unrecoverable, so we'll
      -- upgrade the error.

    ]


-- CCalls
---------

foreign import ccall unsafe "nn.h nn_socket"
  nn_socket :: Domain -> CInt -> IO CInt

foreign import ccall unsafe "nn.h nn_close"
  nn_close :: Socket s p -> IO CInt

foreign import ccall unsafe "nn.h nn_bind"
  nn_bind :: Socket s p -> CString -> IO CInt

foreign import ccall unsafe "nn.h nn_connect"
  nn_connect :: Socket s p -> CString -> IO CInt

foreign import ccall unsafe "nn.h nn_shutdown"
  nn_shutdown :: Socket s p -> CInt {- ^ endpoint -} -> IO CInt
