Idris2/libs/network/Control/Linear/Network.idr

module Control.Linear.Network

-- An experimental linear type based API to sockets

import Data.Maybe

import Control.Linear.LIO

import public Network.Socket.Data
import Network.Socket

public export
data SocketState = Ready | Bound | Listening | Open | Closed

export
data Socket : SocketState -> Type where
     MkSocket : Socket.Data.Socket -> Socket st

export
newSocket : LinearIO io
      => (fam  : SocketFamily)
      -> (ty   : SocketType)
      -> (pnum : ProtocolNumber)
      -> (success : (1 _ : Socket Ready) -> L io ())
      -> (fail : SocketError -> L io ())
      -> L io ()
newSocket fam ty pnum success fail
    = do Right rawsock <- socket fam ty pnum
               | Left err => fail err
         success (MkSocket rawsock)

export
close : LinearIO io => (1 _ : Socket st) -> L io {use=1} (Socket Closed)
close (MkSocket sock)
    = do Socket.close sock
         pure1 (MkSocket sock)

export
done : LinearIO io => (1 _ : Socket Closed) -> L io ()
done (MkSocket sock) = pure ()

export
bind : LinearIO io =>
       (1 _ : Socket Ready) ->
       (addr : Maybe SocketAddress) ->
       (port : Port) ->
       L io {use=1} (Res (Maybe SocketError)
         (\res => Socket (case res of
                               Just _  => Closed
                               Nothing => Bound)))
bind (MkSocket sock) addr port
    = do ok <- Socket.bind sock addr port
         let mbErr = toMaybe (ok /= 0) ok
         pure1 $ mbErr # MkSocket sock

export
connect : LinearIO io =>
          (sock : Socket) ->
          (addr : SocketAddress) ->
          (port : Port) ->
          L io {use=1} (Res (Maybe SocketError)
            (\res => Socket (case res of
                                  Just _  => Closed
                                  Nothing => Open)))
connect sock addr port
    = do ok <- Socket.connect sock addr port
         let mbErr = toMaybe (ok /= 0) ok
         pure1 $ mbErr # MkSocket sock

export
listen : LinearIO io =>
         (1 _ : Socket Bound) ->
         L io {use=1} (Res (Maybe SocketError)
           (\res => Socket (case res of
                                 Just _  => Closed
                                 Nothing => Listening)))
listen (MkSocket sock)
    = do ok <- Socket.listen sock
         let mbErr = toMaybe (ok /= 0) ok
         pure1 $ mbErr # MkSocket sock

export
accept : LinearIO io =>
         (1 _ : Socket Listening) ->
         L io {use=1} (Res (Maybe SocketError) (\case
           Just _  => Socket Listening
           Nothing => LPair (Socket Listening) (Socket Open)))
accept (MkSocket sock)
    = do Right (sock', sockaddr) <- Socket.accept sock
             | Left err => pure1 (Just err # MkSocket sock)
         pure1 (Nothing # (MkSocket sock # MkSocket sock'))

export
send : LinearIO io =>
       (1 _ : Socket Open) ->
       (msg : String) ->
       L io {use=1} (Res (Maybe SocketError)
         (\res => Socket (case res of
                               Just _  => Closed
                               Nothing => Open)))
send (MkSocket sock) msg
    = do Right c <- Socket.send sock msg
             | Left err => pure1 (Just err # MkSocket sock)
         pure1 (Nothing # MkSocket sock)

export
recv : LinearIO io =>
       (1 _ : Socket Open) ->
       (len : ByteLength) ->
       L io {use=1} (Res (Either SocketError (String, ResultCode))
                         (\res => Socket (case res of
                                               Left _  => Closed
                                               Right _ => Open)))
recv (MkSocket sock) len
    = do Right msg <- Socket.recv sock len
             | Left err => pure1 (Left err # MkSocket sock)
         pure1 (Right msg # MkSocket sock)

export
recvAll : LinearIO io =>
          (1 _ : Socket Open) ->
          L io {use=1} (Res (Either SocketError String)
                            (\res => Socket (case res of
                                                  Left _  => Closed
                                                  Right _ => Open)))
recvAll (MkSocket sock)
    = do Right msg <- Socket.recvAll sock
             | Left err => pure1 (Left err # MkSocket sock)
         pure1 (Right msg # MkSocket sock)